ファイルが取得できない。実行時エラー1004

前提・実現したいこと

あるフォルダの中に同じフォーマットでブック名が異なる日報のExcelが20個ぐらいあります。
それぞれのExcelから必要な部分のみ抽出して1つのExcelにまとめるプログラムを書いております。

発生している問題・エラーメッセージ

ファイル名を取得する際に以下のエラーが表示され止まってしまいます。

エラーメッセージ
実行時エラー '1004'
申し訳ございませんC:￥○○￥○○￥本体材料費.xlsxが見つかりません。
名前が変更されたか、移動や削除が行われた可能性があります。

該当のソースコード

Sub test()

'画面出力停止
Application.ScreenUpdating = False

Dim file As String

　　'以下のコードが本エラーの原因と思っております。
file = ThisWorkbook.Path & "本体材料費"

Do While file <> ""

Dim wb As Workbook

'以下のコードでエラーが出ます。
Set wb = Workbooks.Open(file)
Sheets("本体材料費明細提出用（新仕切併用）").Select

Dim i As Long
For i = 22 To 36
    If Not Cells(i, 2) = "" And Not Cells(i, 2) = HasFormula Then
        Range(Cells(i, 15), Cells(i, 45)).Select
        Selection.Copy
        Exit For
    End If
Next i

ThisWorkbook.Activate
Dim x As Long
For x = 22 To 75
    If Cells(x, 2) = wb.Sheets("本体材料費明細提出用（新仕切併用）").Cells(i, 2) Then
        Cells(x, 15).PasteSpecial Paste:=xlPasteValues
        Exit For
    End If
Next x

Workbooks(file).Close savechanges:=False
file = Dir

Loop

'画面出力再開
Application.ScreenUpdating = True

MsgBox "コピー完了しました。"

End Sub

試したこと

5行目の

file = ThisWorkbook.Path & "本体材料費"
が原因と思ったので

file = Dir(ThisWorkbook.Path & "本体材料費")

へ変更したところ、エラーのメッセージが変わり

実行時エラー'1004'
申し訳ございません。「フォルダのなかにある日報Excelのファイル名.xlsm」が見つかりません。名前が変更されたか、移動や削除が行われた可能性があります。

となりました。フォルダの中にエラーメッセージに記載されているブック名のファイルは存在しております。

解決方法を教えていただけないでしょうか。

よろしくお願いいたします。

行動規範の内容に同意します

回答2件

ベストアンサー

作りを見る限りフォルダ内のファイルをループで回そうとしているので、試したことのDirにするのは正しいです。
但し\マークが抜けているので追加が必要です。
またDirの戻り値はファイル名のみなので、ファイルをOpenするときはパス名も指定しないとダメな場合があります。
試しに次のようにしてみてはいかがでしょうか。

VBA
1file = Dir(ThisWorkbook.Path & "*本体材料費*")
2↓
3file = Dir(ThisWorkbook.Path & "*本体材料費*")
4
5Set wb = Workbooks.Open(file)
6↓
7Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & file)

投稿2020/06/01 02:32