I am executing a vba macro in a microsoft word document that has 1600 pages. The macro looks in the document for a specific string. If the string is found, it prints out the page the string is on as a pdf, then it executes the search again in a loop. When I execute this macro on docs that are 200 pgs long, the pdfs are generated quite rapidly- within 5 minutes. However, when I run the same macro on a large document, the pdfs are initially generated rapidly but as the macro progresses down through the document, they are generated more and more slowly. The code gos from a high of 9 pdfs per minute to 1 pdf every 10 minutes. The size of each pdf is going to be the same, and the string I'm searching for occurs every 2 pages. Can anyone shed some light on this? Here's the code...
Public Sub nm22(filetype As String, fsearch As String, fileRealName As String)
Dim cp As Integer
Dim var1, var2 As Variant
Dim int1 As Integer
Dim fname, mstring As String
Dim lnumber As String
Dim exapp As Object
Set exapp = New Excel.Application
Dim kn As Integer
On Error GoTo handle1
'mstring = "k:\common\"
mstring = "C:\welcome\"
With exapp.Application.FileSearch
.LookIn = mstring
.SearchSubFolders = False
.FileName = fileRealName
.Execute
ReDim var2(.FoundFiles.Count - 1)
int1 = 0
For Each var1 In .FoundFiles
'fname = Mid(var1, 22, Len(var1) - 25)
fname = Mid(var1, 12, Len(var1) - 15)
Documents.Open FileName:=var1, ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
Word.Application.Visible = True
ActivePrinter = "Adobe PDF"
Selection.EndKey Unit:=wdStory
Selection.HomeKey Unit:=wdStory
Do While Selection.Find.Execute(findtext:=fsearch, Forward:=True, Wrap:=wdFindStop) = True
Selection.Collapse direction:=wdCollapseEnd
Selection.MoveEnd Unit:=wdLine, Count:=1
If filetype = "GB" Or filetype = "LP" Then
lnumber = Trim(Mid((Selection.Text), 1, Len(Selection.Text) - 1))
ElseIf filetype = "WL" Then
lnumber = Trim(Mid((Selection.Text), 2, Len(Selection.Text) - 2))
ElseIf filetype = "DV" Then
lnumber = Trim(Mid((Selection.Text), 3, Len(Selection.Text) - 3))
End If
Selection.MoveDown Unit:=wdLine, Count:=1
cp = Selection.Information(wdActiveEndSectionNumber)
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="s" & cp & "-" & "s" & (cp), PageType:= _
wdPrintAllPages, Collate:=True, Background:=False, PrintToFile:=False
Name "c:\wiredb\system\" & fname & ".pdf" As "C:\Welcome\" & filetype & "\" & filetype & "_" & lnumber & ".pdf"
Loop
ActiveDocument.Close
Next
End With
MsgBox "Complete"
end sub
Public Sub nm22(filetype As String, fsearch As String, fileRealName As String)
Dim cp As Integer
Dim var1, var2 As Variant
Dim int1 As Integer
Dim fname, mstring As String
Dim lnumber As String
Dim exapp As Object
Set exapp = New Excel.Application
Dim kn As Integer
On Error GoTo handle1
'mstring = "k:\common\"
mstring = "C:\welcome\"
With exapp.Application.FileSearch
.LookIn = mstring
.SearchSubFolders = False
.FileName = fileRealName
.Execute
ReDim var2(.FoundFiles.Count - 1)
int1 = 0
For Each var1 In .FoundFiles
'fname = Mid(var1, 22, Len(var1) - 25)
fname = Mid(var1, 12, Len(var1) - 15)
Documents.Open FileName:=var1, ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
Word.Application.Visible = True
ActivePrinter = "Adobe PDF"
Selection.EndKey Unit:=wdStory
Selection.HomeKey Unit:=wdStory
Do While Selection.Find.Execute(findtext:=fsearch, Forward:=True, Wrap:=wdFindStop) = True
Selection.Collapse direction:=wdCollapseEnd
Selection.MoveEnd Unit:=wdLine, Count:=1
If filetype = "GB" Or filetype = "LP" Then
lnumber = Trim(Mid((Selection.Text), 1, Len(Selection.Text) - 1))
ElseIf filetype = "WL" Then
lnumber = Trim(Mid((Selection.Text), 2, Len(Selection.Text) - 2))
ElseIf filetype = "DV" Then
lnumber = Trim(Mid((Selection.Text), 3, Len(Selection.Text) - 3))
End If
Selection.MoveDown Unit:=wdLine, Count:=1
cp = Selection.Information(wdActiveEndSectionNumber)
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="s" & cp & "-" & "s" & (cp), PageType:= _
wdPrintAllPages, Collate:=True, Background:=False, PrintToFile:=False
Name "c:\wiredb\system\" & fname & ".pdf" As "C:\Welcome\" & filetype & "\" & filetype & "_" & lnumber & ".pdf"
Loop
ActiveDocument.Close
Next
End With
MsgBox "Complete"
end sub