Link to home
Start Free TrialLog in
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
                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
            ' if the system cannot find any files
            ' with the .doc extension
            MsgBox "No files found."
        End If
    End With
End Sub
Avatar of Neil Fleming
Neil Fleming
Flag of United Kingdom of Great Britain and Northern Ireland image

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

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

    '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
 'dispose of the filesystemObject      
Set fS = Nothing
Exit Sub
MsgBox ("An error has occurred")
End Sub

Open in new window

Avatar of Neil Fleming
Neil Fleming
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Milan Soni
Milan Soni


Thanks Neil. It really helped. I tweaked a little to add find and replace portion in code.
My pleasure. Glad it worked.