如何在没有面向每个需要它的Excel的“兼容性检查器”的情况下在directorie中运行macros

我有一个文件夹，我有很多的子文件夹和1000个以上的Excel文件，我正在运行下面的代码为我使用的一个特定的macros（在wb中改变的东西）。 但是这个代码有两个问题，

1. 这个解决scheme将需要我点击继续为每个需要兼容性的Excel（有1000 + Excel）
2. 我需要在这些文件中应用这个macros。 我的意思是我希望这个macros在代码运行后可以在其他计算机上重复使用，然后将这些excel发送到其他计算机上

码

Sub ProcessFiles() Dim objFolder As Object Dim objFile As Object Dim objFSO As Object Dim MyPath As String Dim myExtension As String Dim FldrPicker As FileDialog Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo EmptyEnd MyPath = .SelectedItems(1) End With Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") Call GetAllFiles(MyPath, objFSO) Call GetAllFolders(MyPath, objFSO) Application.ScreenUpdating = True MsgBox "Complete." EmptyEnd: End Sub Sub GetAllFiles(ByVal strPath As String, ByRef objFSO As Object) Dim objFolder As Object Dim objFile As Object Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files DoWork objFile.Path Next objFile End Sub Sub GetAllFolders(ByVal strFolder As String, ByRef objFSO As Object) Dim objFolder As Object Dim objSubFolder As Object Set objFolder = objFSO.GetFolder(strFolder) For Each objSubFolder In objFolder.subfolders Call GetAllFiles(objSubFolder.Path, objFSO) Call GetAllFolders(objSubFolder.Path, objFSO) Next objSubFolder End Sub Sub DoWork(strFile As String) Dim wb As Workbook If Right(strFile, 4) = "xlsx" Then Set wb = Workbooks.Open(Filename:=strFile) With wb 'Do your work here ...... .Close True End With End If End Sub 

Answer 1

尝试在下面的代码（而不是您的Sub ProcessFiles代码）的小修改，

 Sub ProcessFiles() Dim objFolder As Object Dim objFile As Object Dim objFSO As Object Dim MyPath As String Dim myExtension As String Dim FldrPicker As FileDialog Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then Exit Sub ' < can use Exit Sub instead of GoTo MyPath = .SelectedItems(1) End With Application.DisplayAlerts = False ' <-- add this line Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") Call GetAllFiles(MyPath, objFSO) Call GetAllFolders(MyPath, objFSO) ' restore default settings Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Complete." End Sub