使用 VBscript 从不同的 Excel 文件运行 VBA 脚本
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17329799/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Run VBA-script from a different Excel file using VBscript
提问by TitanTheYaphet
I use this code to search through a folder, finding all the excel file(with the same extension), run a VBA script from an opened excel file and save it without prompting.
我使用此代码搜索文件夹，找到所有 excel 文件（具有相同的扩展名），从打开的 excel 文件运行 VBA 脚本并在没有提示的情况下保存它。
strPath = "my path"
pathName="xlsx"
if strPath = "" then Wscript.quit
if pathName = "" then Wscript.quit
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xlsx" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
Set objWorksheet = objWorkbook.WorkSheets(1)
objworksheet.Activate
objExcel.Application.Run "'filename and in quote because there is space.xlsm'!TestingMacro"
objWorkbook.saveas(objFile.Path)
objWorkbook.Close True 'Save changes
End If
Next
objExcel.Quit
However, everytime I run it, it just gives me an runtime error 800A03EC on line objExcel.Application.Run. So wat could I do to resolve it?
但是，每次我运行它时，它都会在 objExcel.Application.Run 线上给我一个运行时错误 800A03EC。那么我能做些什么来解决它？
Thanks!
谢谢！
回答by Ansgar Wiechers
The workbook containing the macro must be opened before you can run macros from it. Open the macro workbook with its full path, but run the macro with just the workbook and macro name.
必须先打开包含宏的工作簿，然后才能从中运行宏。使用完整路径打开宏工作簿，但仅使用工作簿和宏名称运行宏。
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wbm = xl.Workbooks.Open("C:\path\to\macro workbook.xlsm")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder("C:\some\where").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsx" Then
Set wb = xl.Workbooks.Open(f.Path)
Set ws = wb.Sheets(1)
ws.Activate
xl.Application.Run "'macro workbook.xlsm'!TestingMacro"
wb.Save
wb.Close
End If
Next
wbm.Close
xl.Quit
回答by Eduardo Dennis
you are trying to run the macro from your personal workbook it might not work as opening an Excel file with a VBScript doesnt automatically open your PERSONAL.XLSB. you will need to do something like this:
您试图从您的个人工作簿运行宏它可能无法正常工作，因为使用 VBScript 打开 Excel 文件不会自动打开您的 PERSONAL.XLSB。你需要做这样的事情：
Dim oFSO
Dim oShell, oExcel, oFile, oSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
Set oExcel = CreateObject("Excel.Application")
Set wb2 = oExcel.Workbooks.Open("C:\..\PERSONAL.XLSB") 'Specify foldername here
oExcel.DisplayAlerts = False
For Each oFile In oFSO.GetFolder("C:\Location\").Files
If LCase(oFSO.GetExtensionName(oFile)) = "xlsx" Then
With oExcel.Workbooks.Open(oFile, 0, True, , , , True, , , , False, , False)
oExcel.Run wb2.Name & "!modForm"
For Each oSheet In .Worksheets
oSheet.SaveAs "C:\test\" & oFile.Name & "." & oSheet.Name & ".txt", 6
Next
.Close False, , False
End With
End If
Next
oExcel.Quit
oShell.Popup "Conversion complete", 10
So at the beginning of the loop it is opening personals.xlsb and running the macro from there for all the other workbooks. Just thought I should post in here just in case someone runs across this like I did but cant figure out why the macro is still not running.
因此，在循环开始时，它打开personals.xlsb 并从那里为所有其他工作簿运行宏。只是想我应该在这里发帖，以防有人像我一样遇到这个问题，但无法弄清楚为什么宏仍然没有运行。
回答by J P
You may need to run each excel file in the objFolder directory in a new instance of excel.
您可能需要在新的 excel 实例中运行 objFolder 目录中的每个 excel 文件。
strPath = "my path"
pathName="xlsx"
if strPath = "" then Wscript.quit
if pathName = "" then Wscript.quit
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xlsx" Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
Set objWorksheet = objWorkbook.WorkSheets(1)
objworksheet.Activate
objExcel.Application.Run "'filename and in quote because there is space.xlsm'!TestingMacro"
objWorkbook.saveas(objFile.Path)
objWorkbook.Close True 'Save changes
objExcel.Quit
End If
Next
