Sub OpenReportsAndFindReplace() Dim objFileSystem As Object Dim objFolder As Object Dim objFile As Object Dim objActiveDoc As Object Dim objVBComponent As Object

'打开文件夹 Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set objFolder = objFileSystem.GetFolder("C:\Users\Username\Documents\Test Reports")

'循环遍历文件夹中的文件 For Each objFile In objFolder.Files '如果是Excel文件，打开并查找替换 If objFileSystem.GetExtensionName(objFile.Path) = "xls" _ Or objFileSystem.GetExtensionName(objFile.Path) = "xlsx" Then Set objActiveDoc = ThisWorkbook.VBProject.VBE.ActiveVBProject.VBComponents.Import(objFile.Path) For Each objVBComponent In objActiveDoc.VBComponents '查找和替换文本字符串 objVBComponent.CodeModule.ReplaceLine _ objVBComponent.CodeModule.Find("TextToFind"), "ReplacementText" Next objVBComponent '如果是Access文件，则打开并查找替换 ElseIf objFileSystem.GetExtensionName(objFile.Path) = "mdb" _ Or objFileSystem.GetExtensionName(objFile.Path) = "accdb" Then Set objActiveDoc = Application.VBE.VBProjects.Open(objFile.Path) For Each objVBComponent In objActiveDoc.VBComponents '查找和替换文本字符串 objVBComponent.CodeModule.ReplaceLine _ objVBComponent.CodeModule.Find("TextToFind"), "ReplacementText" Next objVBComponent End If Next objFile End Sub