Hello,
I have the following code, which looks for certain text within MS Word and adds the text to an MS Excel spreadsheet. However, every other time I run it, I get the error message, "Run-time error '462': The remote server machine does not exist or is unavailable." The first time it runs, it works, but the second time I run it, I get the error. After reviewing this error on the web, I'm baffled what I'm doing wrong. Can someone help me, please?
Many thanks,
Roy
Code:
Sub findExternalLinks()
'
'
Dim wdApp As Object
Dim wdDoc As Object
Dim aRng As Object
Dim sResponse As String
Dim xlRow As Integer
Dim xlCol As Integer
Dim strFolder As String
Dim StartTime As Date
Dim EndTime As Date
Dim strOutput As String
Dim fileCounter As Integer
Dim Interval As Date
Dim totalFiles As Integer
Dim PctDone As Single
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then
Exit Sub
End If
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Log").Visible = True
StartTime = Now()
UserForm1.Show False
UpdateProgressBar 0
totalFiles = countFiles(strFolder)
xlRow = 1
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
strfile = Dir(strFolder & "\*.doc", vbNormal)
While strfile <> ""
Set wdDoc = Documents.Open(Filename:=strFolder & "\" & strfile, AddToRecentFiles:=False, Visible:=False)
fileCounter = fileCounter + 1
xlCol = 1
ThisWorkbook.Sheets("Log").Cells(xlRow, xlCol).Value = wdDoc.Name
sResponse = "<[32].[231].[PSAR].[.0-9]{1,}" 'Module prefixes 3.2, 2.3, 2.1
Set aRng = wdDoc.Range
With aRng.Find
.ClearFormatting
.Text = sResponse
.MatchWildcards = True
Do While .Execute ' Loop until Word can no longer find the search string
xlCol = xlCol + 1
ThisWorkbook.Sheets("ExtLinksLog").Cells(xlRow, xlCol).Value = aRng.Text
Loop
End With
' Update the percentage completed.
PctDone = fileCounter / totalFiles
' Call subroutine that updates the progress bar.
UpdateProgressBar PctDone
wdDoc.Close False
xlRow = xlRow + 1
strfile = Dir()
Wend
Set aRng = Nothing
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing
Application.ScreenUpdating = True
EndTime = Now()
Interval = EndTime - StartTime
strOutput = Int(CSng(Interval * 24 * 60)) & ":" & Format(Interval, "ss")
ThisWorkbook.Sheets("Log").Cells(xlRow, 1).Value = "This code processed " & fileCounter & " files in " & strOutput
ThisWorkbook.Sheets("Main").Activate
ActiveWorkbook.Save
UserForm1.cmdUnload.Enabled = True
UserForm1.Label1.Caption = "Done!"
UserForm1.LabelFinal.Caption = "This code processed " & fileCounter & " files in " & strOutput
Sub UpdateProgressBar(PctDone As Single)
With UserForm1
' Update the Caption property of the Frame control.
.FrameProgress.Caption = Format(PctDone, "0%")
' Widen the Label control.
.LabelProgress.Width = PctDone * _
(.FrameProgress.Width - 19)
End With
' The DoEvents allows the UserForm to update.
DoEvents
End Sub