特定フォルダ内のエクセルファイルのマクロを実行するマクロに関して

Question

特定のフォルダ内に集められたエクセルを開き、
マクロを実行して閉じるというマクロを作成しようとしています。
まだマクロを触り始めてから3日程度でネットの情報を切り貼りして
作っている状況なので根本的に間違っているかもしれませんが
下記をどのように弄れば思い通りの動作が出来るかご教授願えませんでしょうか。

Sub マクロ実行()
    
    Dim buf As String
    buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xlsm")
    Do While buf <> ""
    
　 Application.Run.Workbook(buf) "Macro1"
    ActiveWorkbook.Close
        
    buf = Dir()
    Loop
End Sub

具体的にはSheet1のA1にフォルダのパスをいれ
そのフォルダにあるマクロ有効ブックを開き、マクロを実行し、保存せずに閉じる
という一連の流れをフォルダ内にある全てのマクロ有効ブックに行おうと考えています。
よろしくお願い致します。

WindFaller · Accepted Answer

すみません。私のミスでした。

>実行の結果としては、ORIGINからDESTINEへ同一のファイルが同一の名前で保存されるという結果でした。

自分のコードの以下の間違いがあります。

With .ActiveSheet
　　　　　　newFn = .Range("C5").Value & " " _
　　　　　　 & .Range("F5").Value & " " _
　　　　　　 & .Range("C6").Value & " " _
　　　　　　 & .Range("F6").Value
　　　　　　 End With
　　　　　　.SaveAs DESTINE & fn, xlOpenXMLWorkbookMacroEnabled　←ここがへん。新しいファイル名になっていません。newFn が正解でした。
　　　　　　.Close False

正しくは、新しいファイル名になっていなくてはならないので、newFn ですね。
　　.SaveAs DESTINE & newFn, xlOpenXMLWorkbookMacroEnabled　'←●
　　でしょうね。

p.s.PCがなくても、頭にPC画面が浮かべば、十分にコードを読みながらマクロの練習は出来ます。私は、道を歩いている時や電車の中で、コードが頭に浮かびました。今は、ちょっとそういう事情ではなくなりましたが。

WindFaller · Answer

さっそく返事をつけていただいてありがとうございました。返事をいただけるかどうか分からなかったし、深夜でしたので、あまり深くは書きませんでした。コードは、 ActiveWorkbook.SaveAs Filename:= _ Range("C5") & " " & Range("F5") & " " & Range("C6") & " " & Range("F6") & ".xls", FileFormat:= _ ここの拡張子は、本来は自動的にはいりますから、このままですと、エラーが発生しています。(添付画像） Range("C5") & " " & Range("F5") & " " & Range("C6") & " " & Range("F6") ,FileFormat:= xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False xlOpenXMLWorkbookMacroEnabled これは、2007以降の拡張子で、xlsmに自動的になります。これはファイル名の拡張子を変えるだけで直ります。(マクロ名　RenamePro） --------- >開かなくてもマクロを実行することが可能 >'Save As'メソッドは失敗しました:'_Workbook'オブジェクト』 >と出て、処理が失敗するといった状況です搭載マクロを見ていませんでしたので、[開かなくても]というのは、モジュールだけ開いて、本体(Workbook)を開いていない方式は、今回の場合は、エラーになります。本体が必要な場合は、二番目の方法は無理です。単なる一案ですから、参考までに。 '// Sub CCC_2() 　　Dim wb As Workbook 　　Dim MYPATH As String 　　Dim fn As String, newFn As String 　　Dim ret As Variant 　　Dim bkName As String 　　'ORIGIN は、元のファイルのフォルダ　　'DESTINE は、コピー先のフォルダ　　Const ORIGIN As String = "C:\Temp\Test2\" 　　Const DESTINE As String = "C:\Temp\Test1\" 　　　　　　fn = Dir(ORIGIN & "\*.xlsm", vbNormal) 　　Application.EnableEvents = False 　　Do While fn <> "" 　　　　On Error Resume Next 　　　　With Workbooks.Open(ORIGIN & fn) 　　　　　　 With .ActiveSheet 　　　　　　newFn = .Range("C5").Value & " " _ 　　　　　　 & .Range("F5").Value & " " _ 　　　　　　 & .Range("C6").Value & " " _ 　　　　　　 & .Range("F6").Value 　　　　　　 End With 　　　　　　.SaveAs DESTINE & fn, xlOpenXMLWorkbookMacroEnabled 　　　　　　.Close False 　　　　End With 　　　　If Err <> 0 Then 　　　　　　 Failed = Failed & " " & fn 　　　　End If 　　　　fn = Dir() 　　Loop 　　 Application.EnableEvents = True 　　Debug.Print Failed '失敗したものは格納 End Sub '// '//正しいファイルが間違って拡張子がついている時に限ります。 '//正しいかどうか判定するプログラムは今回は作りませんでした。 Sub RenamePro() '名前変更プログラム　　Dim fn As String 　　Dim i As Long 　　Const MYPATH As String = "C:\Temp\Test2\"　　　fn = Dir(MYPATH & "*.xls") 　　On Error Resume Next 　　Do While fn <> "" 　　　　Name MYPATH & fn As Left(MYPATH & fn, InStrRev(MYPATH & fn, ".")) & _ 　　　　　　"xlsm" 　　　　　　i = i + 1 　　　　fn = Dir() 　　Loop 　　MsgBox i & "個のファイルを処理しました", vbInformation End Sub -------------- 失礼ですが、 >まだマクロを触り始めてから3日程度でネットの情報を切り貼りして >作っている状況なので根本的に間違っているかもしれませんがこれは本当ですか？私には信じられないです。もし、そうなら、私などが教えるような立場ではないかもしれません。教えても、私の教える内容など、2週間で底がついて、あっさりと、私などは飛び越えていくのでしょうね。世の中には時々そういう人がいます。例えば、プロジェクトA の井川はるきさんみたいに、2年たらずで、VBAの天辺まで登りつめるとか、夢ではないような気がします。彼は、阪大で歯学を勉強していて、それをやめて、この業界に入ったそうですから、それなりに見合うものがなければ、医者をしていたでしょう。私からのほんのちょっとしたアドバイスは「会社に潰されないようにね。会社の便利な道具にならない」ということではないでしょうか。私の知人たちで、壊れてしまった人も何人かいます。それと、私のPCの師匠(インストラクター養成の講師）は、関係のない業界でしたが、会社を退職して60歳から、プロになった人ですが、まず最初に、コンピュータ関係の資格を取っていったそうです。市井の達人というのは、今の時代はダメのようです。

WindFaller · Answer

こんばんは。今までの使っていたファイル群がフォルダーに残って記憶も新しい間に、こちらも片付けたいと思います。以下のマクロは、正直、汚いです。実験的にいろいろ試してみた結果です。まず、マクロの入っているファイルは本来は、Openをしなくても、モジュールのみから起動させるとも可能だということです。ですが、このマクロの目的が、マクロのあるなしの検査の目的かもしれません。なお、ret は、まったく意味がありませんが、(　）をつけたために、見かけ上、必要になっただけたです。(　) がなければ、ret も不要です。なお、Run の後のファイル名の書き方は、Excelの独特の書き方を要求されることが多いです。状況によって、ファイルの書き方が変わります。 >そのファイルのマクロの内容は指定セルに入力されている文字をファイル名として指定のフォルダに保存するというものですこの内容は、各々のマクロの実行は不要ではありませんか？外部のマクロで、取り出してしまえば良いと思います。とは言え、マクロを触り始めた人には、雲をつかむような話かもしれませんね。 '// Sub CCC() 　　Dim wb As Workbook 　　Dim MyPath As String 　　Dim fn As String 　　Dim ret As Variant 　　'Dim Passed As String　　'成功したファイ名　　Dim Failed As String '失敗したファイル名　　　　MyPath = Worksheets("Sheet1").Range("A1").Value 　　If MyPath = "" Then MsgBox "パス名がありません。", vbCritical: Exit Sub 　　　　If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 　　fn = Dir(MyPath & "\*.xlsm", vbNormal) 'ファイルのあるなしの確認　　Do While fn <> "" 　　　　On Error Resume Next '*** 　　　　With Workbooks.Open(MyPath & fn) 　　　　　　ret = Application.Run("'" & .Name & "'!Macro1")　'マクロ実行　　　　　　.Close False 　　　　End With '*** 　　　　If Err = 0 Then 　　　　'　　 Passed = Passed & "," & fn 　　　　Else 　　　　　　Failed = Failed & " " & fn '現行は失敗したものだけにする　　　　End If 　　　　fn = Dir() 　　Loop 　　'Debug.Print Passed 　　Debug.Print Failed 'イミディエイト・ウィンドウに表示 End Sub '// 上記の*** ～***の間を、 '*** 　ret = Application.Run("'" & MyPath & fn & "'!Macro1") 　 Workbooks(fn).Close False '*** とすれば、開かなくても、マクロの実行は可能です。失敗、もしくは、成功は、イミディエイト・ウィンドウに記録されます。

ママチャリ · Answer

No1 ママチャリです。
当方、Excel2010なのですが、一応、動作確認はしたつもりなのですが…。
マクロ名が「Macro1」ではないって落ちは無いですよね？
ちなみに「手動ではきちんと実行できる」とのことなので、その動作を自動記録してみて下さい。記録されたマクロを参考にプログラムを書き換えてみて下さい。

ママチャリ · Answer

回答が付かないようなので…
とりあえず、こんな感じで動くと思うのですが、実行結果については、各ブックに記述されているMacro1の内容に依存するので、何が起こるかわかりません。慎重に作業することをお勧めします。

Sub マクロ実行()
    Dim wb As Workbook
    Dim buf As String
    buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xlsm")
    Do While buf <> ""
        Set wb = Workbooks.Open(Sheets("Sheet1").Range("A1").Value & "\" & buf)
        Application.Run (buf & "!Macro1")
        wb.Close (False)
        buf = Dir()
    Loop
End Sub

特定フォルダ内のエクセルファイルのマクロを実行するマクロに関して

すみません。

さっそく返事をつけていただいてありがとうございました。

こんばんは。

No1 ママチャリです。

回答が付かないようなので…

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング