Avatar of Milan Soni
Milan Soni
 asked on

Getting error while doing mass find n replace in Sub folder

When I am running the below code for n number of document in a folder then it works fine but when i inclde more sub folder with the docs then it shows the error
"Run-time error '5792':
The files appears to be corrupted.

Can someone help? I am not much familier with coding.

Public Sub MassReplace()
    With ApplicationFileSearch
        .LookIn = "C:\Users\milans\Desktop\Procedure - Test"             ' where to search
        .SearchSubFolders = True    ' search the subfolders
        .FileName = "*.docx"         ' file pattern to match

        ' if more than one match, execute the following code
        If .Execute() > 0 Then
            ' for each file you find, run this loop
            For i = 1 To .FoundFiles.Count
                ' open the file based on its index position
                Documents.Open FileName:=.FoundFiles(i), ReadOnly:=False   'I tracked error it is the line where erorr is coming

                ' search and replace the address
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "ABC"
                    .MatchCase = True
                    .Replacement.Text = "XYZ"
                End With
                Selection.Find.Execute Replace:=wdReplaceAll


                ' save and close the current document
                ActiveDocument.Close wdSaveChanges
            Next i
        Else
            ' if the system cannot find any files
            ' with the .doc extension
            MsgBox "No files found."
        End If
    End With
End Sub
Microsoft OfficeMicrosoft Word

Avatar of undefined
Last Comment
Neil Fleming

8/22/2022 - Mon
Neil Fleming

The built-in Application.Filesearch ceased to exist with Office 2010. It looks as if you are using a custom Class module called "ApplicationFileSearch" (with no period) that tries to replicates the functionality.

Possibly the error is in the code for that class module.

However, it is also possible that your code is simply not detecting temporary files created by Word, that is files whose name begins with a tilde "~" eg
"~myfile.docx"

Open in new window

. Attempts to open these files will result in the error that you report. It may be by chance that such files only exist in your sub-folders. In any case you can try fixing this by re-writing your code to read:
 For i = 1 To .FoundFiles.Count
 ' open the file based on its index position
'check first letter of filename for "~"
If Left(.Foundfiles(i),1)<>"~" then 
Documents.Open FileName:=.FoundFiles(i), ReadOnly:=False
'etc etc.. perform the search and replace and then:
End If
'etc etc

Open in new window


However, you may be better off ditching your class module and re-writing the procedure to use Microsoft's FileSystemObject . Something like this code below, which I wrote assuming you are doing this from Excel (not sure why I thought that). If you are doing it from Word itself, then there is no need for the creation of the WordApp variable or the later reference to it. You can just use:
Documents.Open Filename:=fFile.Path, ReadOnly:=False

Open in new window

as in your original code.

Note that you would need to manually add references to the Word library and to Microsoft Scripting Runtime in the "Tools|References" menu in the VBA editor.

Sub changeAll()
'routine to call MassReplace with specific folder:
MassReplace "C:\Users\milans\Desktop\Procedure - Test"
End Sub

Public Sub MassReplace(sFolder As String)
'NB:requires reference to Microsoft Word in Tools|References:
Dim WordApp As Word.Application
'requires reference to Microsoft Scripting Runtime in Tools|References:
Dim fS As New FileSystemObject
Dim fFolder As Folder, fSubfolder As Folder, fFile As File
Dim sExt As String

On Error GoTo errortrap
'this assumes you have Word running, otherwise you will need additional code to open it if not
Set WordApp = GetObject(, "Word.Application")
Set fFolder = fS.GetFolder(sFolder)
    'loop through subfolders, running MassReplace on each of them
    For Each fSubfolder In fFolder.SubFolders
    MassReplace fSubfolder.Path
    Next

    'now check files in folder
    For Each fFile In fFolder.Files
    sExt = fS.GetExtensionName(fFile)
    'open .docx files that are not temp copies whose name begins with "~":
        If (sExt = "docx") And (Left(fFile.Name, 1) <> "~") Then
        WordApp.Documents.Open Filename:=fFile.Path, ReadOnly:=False
        'perform changes to file HERE
        'then close file
        WordApp.ActiveDocument.Close wdSaveChanges
        End If
    Next
 'dispose of the filesystemObject      
Set fS = Nothing
Exit Sub
errortrap:
MsgBox ("An error has occurred")
          
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Neil Fleming

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Milan Soni

ASKER
Thanks Neil. It really helped. I tweaked a little to add find and replace portion in code.
Neil Fleming

My pleasure. Glad it worked.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck