VBA Changes the Directory and I Get Error 5174 - Help

[RobVos]

Hi,

I have some code that I want to go through a folder and do a search and replace in documents. The code seems to work, however it keeps only doing one more file than previous time when run, then I get a Run-time error 5174 - This file could not be found.

When I run the code the first time, it opens the first file and does the replacement then when it tries to open the next file I will get the error. The messagebox indicates the correct path and file name is ready to open, but when the error comes up it has changed the path to c:\users\myaccount\documents\ vice the directory I had indicated.

For example if the directory I am using is c:\Test\ the MessageBox displays "c:\Test\FName is ready to open", but the error will say "This file could not be found (c:\users\myaccount\documents\FName)"

If I run the code again, it will correctly open the first 2 files then on the third, the error will come up.
If I run it yet again, it will correctly open the first 3 files then on the forth, the error will come up.
Every time I run the code it will always go one file more than the previous time then error.

Here is the code:


Public Sub Replacement()
Dim rngStory As Range
Dim Directory As String
Dim FType As String
Dim FName As String


Directory = InputBox("Directory of files location")
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"

FType = "*.docx"


ChDir Directory

FName = Dir(FType)

Do While FName <> ""

MsgBox Directory & FName & " is ready to open."
Documents.Open FileName:=FName

' search the entire document and replace
For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.Text = "N32205-13-R-2010"
.Replacement.Text = "N62649-15-R-0229"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next rngStory

' save and close the current document
ActiveDocument.Close wdSaveChanges


' look for next matching file
FName = Dir
Loop
End Sub

[gmayor]

Using an Input box is not the best way to get the folder name, and you need to add the path when opening the document. The following should work for you:



Public Sub Replacement()
Dim rngStory As Range
Dim Directory As String
Dim FType As String
Dim FName As String
Dim oDoc As Document
Directory = BrowseForFolder("Select folder to process")
If Directory = vbNullString Then
MsgBox "User cancelled"
GoTo lbl_Exit
End If
FType = "*.docx"
FName = Dir$(Directory & FType)
While Len(FName) <> 0
MsgBox Directory & FName & " is ready to open."
Set oDoc = Documents.Open(Filename:=Directory & FName, AddToRecentFiles:=False)

' search the entire document and replace
For Each rngStory In oDoc.StoryRanges
With rngStory.Find
.Text = "N32205-13-R-2010"
.Replacement.Text = "N62649-15-R-0229"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next rngStory
' save and close the current document
oDoc.Close wdSaveChanges
' look for next matching file
FName = Dir$
Wend
lbl_Exit:
Exit Sub
End Sub

Private Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
On Error GoTo err_handler
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = strTitle
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then GoTo err_handler:
BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
End With
lbl_Exit:
Exit Function
err_handler:
BrowseForFolder = vbNullString
Resume lbl_Exit
End Function

[RobVos]

Thank you very much - works great!