Hello everyone,
I recently made a macro which would search for specific keywords in a
list of Microsoft word files and find the number of occurance of the
particular keyword. The problem is that everytime this macro opens a
new word file, it takes a lot of time. I am new to object oriented
programming. If anybody has any ideas of making this macro faster,
please suggest. Thank you.
A core part of the macro is as given below.
-----------------------------------------------------
For Each nDocFile In Range("B4:B" & FindLastRow("B4")).Cells
sDoc = Range("B1").Value & "\" & nDocFile.Value
Set wordApp = CreateObject("Word.Application")
nDocFile.Select
wordApp.Documents.Open (sDoc)
wordApp.Visible = False
For Each nWord In Range(Cells(3, 4), Cells(3, UBound(aKeywords) +
3)).Cells
sText = nWord
With wordApp.Selection.Find
.MatchWholeWord = True
Counter = 0
Do While .Execute(FindText:=sText, Forward:=True) =
True
Counter = Counter + 1
Loop
End With
nDocFile.Offset(0, nWord.Column - 2).Value = Counter
Next
wordApp.Quit
Set wordApp = Nothing
Next
Perhaps something like this (untested):
Dim wordApp As Application
Dim vWords As Variant
Dim vResults As Variant
Dim rCell As Range
Dim i As Long
Dim Counter As Long
Dim sPath As String
sPath = Range("B1").Text & Application.PathSeparator
Set wordApp = CreateObject("Word.Application")
vWords = Cells(3, 4).Resize(1, UBound(aKeyWords)).Value
ReDim vResults(1 To 1, 1 To UBound(vWords, 2))
With wordApp
For Each rCell In Range("B4:B" & _
Range("B" & Rows.Count).End(xlUp).Row)
.Documents.Open sPath & rCell.Text
.Visible = False
For i = 1 To UBound(vWords, 2)
With .Selection.Find
.MatchWholeWord = True
Counter = 0
Do While .Execute( _
FindText:=vWords(1, i), _
Forward:=True)
Counter = Counter + 1
Loop
End With
vResults(1, i) = Counter
Next i
rCell.Offset(0, 2).Resize(1, UBound(vResults, 2)).Value = _
vResults
Next rCell
.Quit
End With
Couple of things to point out:
1) no need to close and open the word app each time
2) no need to reference the target cells each time - storing their
values in a variable once is faster
3) storing the results in an array and writing it once is faster than
referencing/writing to each cell.
4) Depending on aKeyWords, vWords may be redundant - can't tell without
seeing the code.
In article <1139671052.760318.233160@g47g2000cwa.googlegroups.com>,
"RosH" <roshin.majeed@gmail.com> wrote:
> Hello everyone,
> I recently made a macro which would search for specific keywords in a
> list of Microsoft word files and find the number of occurance of the
> particular keyword. The problem is that everytime this macro opens a
> new word file, it takes a lot of time. I am new to object oriented
> programming. If anybody has any ideas of making this macro faster,
> please suggest. Thank you.
>
> A core part of the macro is as given below.
>
> -----------------------------------------------------
>
> For Each nDocFile In Range("B4:B" & FindLastRow("B4")).Cells
> sDoc = Range("B1").Value & "\" & nDocFile.Value
> Set wordApp = CreateObject("Word.Application")
> nDocFile.Select
> wordApp.Documents.Open (sDoc)
> wordApp.Visible = False
>
> For Each nWord In Range(Cells(3, 4), Cells(3, UBound(aKeywords) +
> 3)).Cells
> sText = nWord
>
> With wordApp.Selection.Find
> .MatchWholeWord = True
> Counter = 0
> Do While .Execute(FindText:=sText, Forward:=True) =
> True
> Counter = Counter + 1
> Loop
> End With
>
> nDocFile.Offset(0, nWord.Column - 2).Value = Counter
>
> Next
>
> wordApp.Quit
> Set wordApp = Nothing
>
> Next
Thank you so much JE, ill incorporate these into my code.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks