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

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

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

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.