
■質問内容
下記マクロで、Dir関数のループ中にサブルーチンでDir関数を使用しています。
この場合、Macro1のDir関数がリセット(?)されて、やりたいことができません。
この状況を解消するうまい方法はないでしょうか?
Macro1、Macro2ともファイル名はID以外は変動するためどちらもワイルドカードを使用ていします。
Sub Macro1()
'所定のフォルダ内のファイルをループするマクロ
Dim strPathName As String, strFilename As String
strPathName = "C:\temp1"
'Aから始まるファイルを取得
strFilename = Dir(strPathName & "\A*.xlsx")
'全ファイルループ
Do While strFilename <> ""
Call Macro2(strFilename)
'次のファイル名を取得
strFilename = Dir
Loop
End Sub
Sub Macro2(strFilename As String)
'strFilenameが持っているIDを取得して、別の対応ファイルを取得するマクロ
Dim strID As String
Dim targetFilename As String, targetPath As String
'ファイル名に含まれているIDを取得
targetID = Split(strFilename, "_")(1)
'探し出すファイルが保存されているフォルダパス
targetPath = "C:\temp2"
'探し出すファイル名取得(IDを含んでいる)
targetFilename = Dir(targetPath & "\*" & targetID & "*.xlsx")
End Sub
■動作環境
OS 名:Microsoft Windows 10 Pro
OS バージョン:10.0.16299 N/A ビルド 16299
OS 製造元:Microsoft Corporation
プロセッサ:Intel64 Family 6 Model 42 Stepping 7 GenuineIntel ~2400 Mhz
BIOS バージョン:TOSHIBA Version 2.20 , 2012/06/22
物理メモリの合計:3,988 MB
Excel バージョン:14.0.7192.5000(32ビット) Microsoft Office Standard 2010の一部
以上、ご存知の方ご教示いただければ幸いです。

No.5ベストアンサー
- 回答日時:
Macro1のみFileSystemObjectを使用する方法に変えました。
Macro2のなかでDir()が使用可能になります。
参照設定でMicrosoft Scripting Runtimeにチェックをいれてから、実行してください。
Sub Macro1()
'所定のフォルダ内のファイルをループするマクロ
Dim strPathName As String, strFilename As String
Dim wfso As New FileSystemObject
Dim wfolder As Folder
Dim wfiles As Files
Dim wfile As File
strPathName = "C:\temp1"
Set wfolder = wfso.getfolder(strPathName)
Set wfiles = wfolder.Files
'取得したファイル一覧について処理
For Each wfile In wfiles
'A*.xlsxにマッチするファイルのみ処理する
If LCase(wfile.Name) Like "a*.xlsx" Then
Call Macro2(wfile.Name)
End If
Next
End Sub

No.6
- 回答日時:
dir関数は多重にできないので、外側のループの処理結果を配列やCollectionに取得しておく必要があります。
質問の処理をCollectionを使って置き換える場合です。
出来るだけ元のプログラムを残しています。
Macro2はそのままです。
Sub Macro1()
'所定のフォルダ内のファイルをループするマクロ
Dim strPathName As String, strFilename As String
strPathName = "C:\temp1"
'Aから始まるファイルを取得
strFilename = Dir(strPathName & "\A*.xlsx")
'対象ファイル取得
Dim co As New Collection 'ファイル名記憶用Collection
Do While strFilename <> ""
'Collectionに追加
co.Add strFilename
'次のファイル名を取得
strFilename = Dir
Loop
'全ファイルループ
Dim f As Variant
'Collectionの値を順に
For Each f In co
'Macro2にCollectionの値を渡す
Call Macro2(CStr(f))
Next
End Sub

No.4
- 回答日時:
'Aから始まるファイルを取得
strFilename = Dir(strPathName & "\A*.xlsx")
'全ファイルループ
Do While strFilename <> ""
'ファイル名を配列に格納
ReDim Preserve 配列(i)
配列(i) = strFilename
i = i + 1
'次のファイル名を取得
strFilename = Dir()
Loop
'配列をループ
For i = 0 To UBound(配列)
Call Macro2(配列(i))
Next i
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
画面を強制的に再描画させる方法
-
UWSCの終了の仕方
-
アクティブセルから、A列最終行...
-
Escキーを押すと、中断する時と...
-
「偶数・奇数の和」のフローチ...
-
For文を使った九九表の作成
-
DOSコマンドのループ内のTIMEコ...
-
UWSCのスクリプトで行き詰って...
-
VBAでこの様なコード時のセルの...
-
WinAPI「MsgWaitForMultipleObj...
-
繰り返し処理で50音順にする方法
-
流れ図(フローチャート)が分か...
-
VBAでの一時停止と再開の方法
-
VBA横データを縦にしたいです
-
プログラムはif文とforループが...
-
レインボー色ってどうやって表...
-
正しいWebBrowserの使い方(ル...
-
VB2010でCSVファイルの読み込み
-
Application->Run();の機能につ...
-
エクセルの当番表を作っていま...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
画面を強制的に再描画させる方法
-
UWSCの終了の仕方
-
CSVファイルの特定の行だけを読...
-
範囲指定したセルを1つずつ飛...
-
UWSCに制限時間を付けたいです
-
Escキーを押すと、中断する時と...
-
乱数の桁数指定、または範囲指定。
-
VBA for i=1 to lastrow
-
流れ図(フローチャート)が分か...
-
DOSコマンドのループ内のTIMEコ...
-
pythonでファイルのコメント行...
-
素数表について。
-
VBAでの一時停止と再開の方法
-
「偶数・奇数の和」のフローチ...
-
DoEventsが必要な理由について
-
vb.netです。2次元配列の要素を...
-
Do whileでExitせず、ループの...
-
ループフリー
-
エクセルの当番表を作っていま...
-
VBAで3秒だけ時間を止めたい
おすすめ情報
みなさま回答ありがとうございます。
この記載の方法は無理なのは把握しているのですが、やりたいことを伝えるためにかいております。
やりたいことをどのようにすればやれるかを模索しているところですm(_ _)m