Dir関数の利用で初心者がハマりがちな注意点 – Excelマクロ・VBA

先日はありがとうございました。
10日11日のマクロ講習会を受講した仙台のデコです。

あれから毎日送られてくる課題を楽しみに解いていました。
まだまだすんなり出来るようにはなりませんが、時間を忘れる楽しさですね。

そんな今日この頃、タイミングよく？実業務でマクロをくむ仕事が入りました。

なんとか自力で組んでみたものの、実行途中でエラーで止まってしまいます。

ネット等で調べても手掛かりが見つからず、年末のお忙しい中お手数ですが、原因及び解決法をご教示いただきたくよろしくお願いします。

内容は、1つのフォルダ内にある複数ファイルのうち、条件に合う名前のファイルを開いて、各々のシートの指定エリアを同フォルダの親ファイルにコピーしていくというものです。
貼り付ける際、既に貼り付けたデータを消さないよう「空白セルを無視して」貼り付けています。

マクロは以下の通りです。

Sub juchu_test1()
    Dim ws1 As String
    Dim ws2 As String
    ws1 = ThisWorkbook.Worksheets(1).Name
    ws2 = ThisWorkbook.Worksheets(2).Name
    Dim oWB As Workbook
    Dim sFname As String
    sFname = Dir(ThisWorkbook.Path & “\” & “*受注*.xlsx”, vbNormal)
    Do While sFname <> “”
        Set oWB = Workbooks.Open(Filename:=ThisWorkbook.Path & “\” & sFname, UpdateLinks:=False, ReadOnly:=True)
        Debug.Print Dir
        oWB.Worksheets(ws1).Range(“B2:G9”).Copy
        ThisWorkbook.Worksheets(ws1).Activate
        Range(“B2”).PasteSpecial Paste:=xlPasteAll, Skip
Blanks:=True

        oWB.Worksheets(ws2).Range(“B2:M9”).Copy
        ThisWorkbook.Worksheets(ws2).Activate
        Range(“B2”).PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True

        Application.CutCopyMode = False
        oWB.Close SaveChanges:=False
        sFname = Dir()             ‘ 次のファイル名を参照
    Loop
End Sub

3～4ファイルまではうまくいくのですが、すべての処理が終わらないうちに、下から3行目のsFname = Dir()で下記のエラーが表示して止まってしまいます。

実業務データと似たようなサンプル環境を作って同じマクロを動かしてみましたが、同様の現象でした。

作ったサンプル環境ごと送信させていただきますのでよろしくお願いします。

以上

Sub juchu_test1_ogawa()
    Dim ws1 As String
    Dim ws2 As String
    ws1 = ThisWorkbook.Worksheets(1).Name
    ws2 = ThisWorkbook.Worksheets(2).Name
    Dim oWB As Workbook
    Dim sFname As String
    sFname = Dir(ThisWorkbook.Path & “\” & “*受注*.xlsx”, vbNormal)
    Do While sFname <> “”
‘        Set oWB = Workbooks.Open(Filename:=sFname, UpdateLinks:=False, ReadOnly:=True)
        Set oWB = Workbooks.Open(Filename:=ThisWorkbook.Path & “\” & sFname, UpdateLinks:=False, ReadOnly:=True)
        
        ‘以下、実行してみてください。（要は、Dir関数を実行する都度、次のファイルに処理対象が移ってしまうのです。）
        Debug.Print Dir ‘[1]
        Debug.Print Dir ‘[2]
        Debug.Print Dir ‘[3]
        Debug.Print Dir ‘[4]
        Debug.Print Dir ‘[5]
    
        oWB.Worksheets(ws1).Range(“B2:G9”).Copy
        ThisWorkbook.Worksheets(ws1).Activate
        Range(“B2”).PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True
                        
        oWB.Worksheets(ws2).Range(“B2:M9”).Copy
        ThisWorkbook.Worksheets(ws2).Activate
        Range(“B2”).PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True
        
        Application.CutCopyMode = False
        oWB.Close SaveChanges:=False
        sFname = Dir()
    Loop
End Sub

デコさん、こんにちは。

VBAでDir関数を使い始めたばかりのころに、ありがちなハマりです (^^;
Dir関数を実行する都度、次のファイルに処理対象が移ってしまいます。

分かりやすいよう、極端な例を作ってみました。

イミディエイトウィンドウの内容がどう変わるか注意しながら、添付のサンプルを実行してみてください。
デコさんなら、それでもうご理解いただけるかと思います。

対処ですが、

Debug.Print Dir

のところ

Debug.Print oWB.Name

とすればよさそうに思います。

以上、多少乱暴な気もしますが。。デキる人向けの回答なので、手短に (^^;

Dir 関数を最初に呼び出すとき、引数 pathname を指定しないとエラーになります。またファイル属性 (引数 attributes) を指定する場合にも、引数 pathname を指定する必要があります。

Dir 関数は、引数 pathname と一致する最初のファイル名を返します。それ以外のファイル名で引数 pathname と一致するファイル名を取得するには、引数を指定せずに再び Dir 関数を呼び出してください。

小川先生！
驚くほど迅速な回答ありがとうございました！

お返事いただきすっきりしました。
というか、言われてみたらななぜ気付かなかったのかと・・・

年明けには早々エンドユーザへの最終回答ができそうです。
ありがとうございました。
またお願いすると思いますが、よろしくお願いします。