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!