VBA如何将文件夹中的Excel文件replace为启用macros的工作簿

试图找出如何将所选文件夹中的所有Excel文件保存为启用macros的工作簿。 如果可能，我想只保存启用macros的工作簿来replace文件夹中的所有excel文件。 目前我只有代码打开文件夹中的一个Excel文件 – 我不知道如何将打开的工作簿保存为启用macros的工作簿，没关系通过整个文件夹循环。 这是我有的代码，如果我使用一个if语句而不是一个do while循环来打开一个文件，它可以在一个文件上工作。 它说在do while循环中有一个file = dir的错误：

Sub SaveAllAsMacroWkbks() Dim wb As Workbook Dim myPath As String Dim myFile As String, macFile As String Dim myExtension As String, macExt As String Dim FldrPicker As FileDialog 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" macExt = "*.xlsxm" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) macFile = Dir(myPath & macExt) 'Loop through each Excel file in folder Do While myFile <> "" Set wb = Workbooks.Open(Filename:=myPath & myFile) 'wb.saveAs FileName:=macFile, FileFormat:=52 'wb.Close SaveChanges:=True 'Get next file name myFile = Dir Loop ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 1

下面的代码应该可以帮助你。

 Sub SaveAllAsXLSM() ' 27 Oct 2017 Dim FldrPicker As FileDialog Dim myPath As String Dim myFile As String, newFile As String Dim Fn() As String Dim i As Long Dim Wb As Workbook ' Optimize Macro Speed Application.ScreenUpdating = False ' You aren't making any changes that trigger calculations ' nor do you have event procedures in your VB Project ' Therefore these commands do nothing but to take their own time to execute ' Application.EnableEvents = False ' Application.Calculation = xlCalculationManual ' User selects Target Folder Path Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show Then myPath = .SelectedItems(1) & "\" End With If Len(myPath) Then myFile = Dir(myPath) Do While Len(myFile) Fn = Split(myFile, ".") i = UBound(Fn) If StrComp(Fn(i), "xlsx", vbTextCompare) = 0 Then myFile = myPath & myFile Debug.Print myFile Set Wb = Workbooks.Open(Filename:=myFile) Fn(i) = "xlsm" newFile = myPath & Join(Fn, ".") Debug.Print newFile Wb.SaveAs Filename:=newFile, FileFormat:=52 Wb.Close SaveChanges:=False Do ' let the hard disc catch up with the VBA code DoEvents Loop While IsOpen(myFile) Kill myFile ' delete the original End If myFile = Dir Loop End If Application.ScreenUpdating = True End Sub Private Function IsOpen(Fn As String) As Boolean ' 27 Oct 2017 Dim i As Integer With Workbooks For i = 1 To .Count If StrComp(Fn, .Item(i).FullName, vbTextCompare) = 0 Then IsOpen = True Exit For End If Next i End With End Function 

我不认为你可以在PC和vv上处理Mac文件。但是，如果有可能，你可以轻松地调整我的代码。 你可以用xls扩展名来做同样的事情。

我对VBA和硬盘的不同速度有一些疑问。 DoEvents的循环应该会减慢代码的速度。 这肯定会减慢代码的执行速度，但是我不太确定DoEvents是否能按预期工作。 如果没有，代码将仍然太快。

Answer 2

请注意，macros工作簿扩展名是.xlsm，而不是您的代码中的.xlsxm。

这里有一种方法可以循环访问文件夹中的文件（您必须在Tools-> References中添加对Microsoft Scripting Runtime的引用）：

 Dim fso As New FileSystemObject Dim folder As folder Dim file As file Set folder = fso.GetFolder("C:\Users") For Each file In folder.Files 'do stuff Next 

这可以将工作簿保存为：

 Workbook.SaveAs Filename:="C:\Users\....\filename.xlsm",FileFormat:=xlOpenXM‌​LWorkbookMacroEnable‌​d, CreateBackup:=False