0

このコードを使用してフォルダーを検索し、すべての 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

ただし、実行するたびに、objExcel.Application.Run 行で実行時エラー 800A03EC が発生します。それで、それを解決するために私は何ができますか？

ありがとう！

4

3 に答える 3

3

マクロを実行する前に、マクロを含むブックを開く必要があります。完全なパスでマクロ ブックを開きますが、ブックとマクロ名だけでマクロを実行します。

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
于 2013-06-26T21:26:04.900 に答える
-1

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
于 2013-06-26T20:47:44.417 に答える