VBAでパスおよびファイル名が正しいのに、実行時エラー1004となります

実現したいこと

VBAでパスおよびファイル名が正しいのに、実行時エラー1004となります
回避方法を教えてください
コードはChatGPTで生成しています
文法チェックはクリアしています

発生している問題・分からないこと

VBAでパスおよびファイル名が正しいのに、実行時エラー1004となります

エラーメッセージ

error

1実行時エラー1004 2統合手数料管理表_試験.xlsx"が見つかりません。削除された可能性があります。

該当のソースコード

VBA

1Sub ExtractAndCopyData() 2 3 ' 画面更新を禁止 4 Application.ScreenUpdating = False 5 6 ' 変数の宣言 7 Dim srcWorkbook As Workbook 8 Dim destWorkbook As Workbook 9 Dim srcSheet As Worksheet 10 Dim destSheet As Worksheet 11 Dim lastRow As Long 12 Dim destRow As Long 13 Dim i As Long 14 Dim destFilePath As String 15 Dim scheduledDate As String 16 17 ' 抽出元のパスとファイル名を指定 18 Dim srcPath As String 19 Dim srcFile As String 20 srcPath = "C:\Users\yamada\グループ Dropbox\山田\手数料\実験\" 21 srcFile = "統合手数料管理表_試験.xlsx" 22 23 ' 入力するExcelファイルを開く 24 Set srcWorkbook = Workbooks.Open(srcPath & srcFile) 25 26 ' コピー元のシートを指定 27 Set srcSheet = srcWorkbook.Sheets("統合シート") 28 29 ' 新しいExcelブックを作成 30 Set destWorkbook = Workbooks.Add 31 Set destSheet = destWorkbook.Sheets(1) 32 33 ' コピー先の行を初期化 34 destRow = 1 35 36 ' 入力するExcelファイルの最終行を取得 37 lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row 38 39 ' データを抽出して新しいExcelにコピー 40 For i = 1 To lastRow 41 ' 抽出条件: x列にデータがある、またはAA列にデータがある 42 If Not IsEmpty(srcSheet.Cells(i, 24)) Or Not IsEmpty(srcSheet.Cells(i, 27)) Then 43 ' x列, W列, Z列, AA列をコピー 44 destSheet.Cells(destRow, 1).Value = srcSheet.Cells(i, 24).Value ' x列 45 destSheet.Cells(destRow, 2).Value = srcSheet.Cells(i, 23).Value ' W列 46 destSheet.Cells(destRow, 3).Value = srcSheet.Cells(i, 26).Value ' Z列 47 destSheet.Cells(destRow, 4).Value = srcSheet.Cells(i, 27).Value ' AA列 48 destRow = destRow + 1 49 End If 50 Next i 51 52 ' 予定日を取得 (A1セルの値を予定日とする) 53 scheduledDate = srcSheet.Cells(1, 1).Value 54 55 ' ファイル名を設定 56 destFilePath = srcPath & scheduledDate & "_手数料.xlsx" 57 58 ' 新しいExcelファイルを保存 59 destWorkbook.SaveAs destFilePath 60 61 ' ファイルを閉じる 62 srcWorkbook.Close SaveChanges:=False 63 destWorkbook.Close SaveChanges:=True 64 65 ' 変数のクリア 66 Set srcSheet = Nothing 67 Set destSheet = Nothing 68 Set srcWorkbook = Nothing 69 Set destWorkbook = Nothing 70 71 ' 画面更新を許可 72 Application.ScreenUpdating = True 73 74 MsgBox "データの抽出とコピーが完了しました。" 75 76End Sub 77

試したこと・調べたこと

上記の詳細・結果

ファイルがDropBOXにあったので、デスクトップにコピーして実行したが、同じエラーと
なります

補足

Chatgptのプロンプトです

#あなたはVBAの専門家です。下記に指定した条件でVBAを生成して下さい

#詳細
このVBAは入力するExcelと新しいExcelを指定するコードも含んで下さい
コメントは詳細に

#抽出元パス
C:\Users\yamada\グループ Dropbox\山田\手数料\実験

#抽出元ファイル
統合手数料管理表_試験.xlsx

#抽出元ファイルのシート名
統合シート

#新しいファイル名
日付単位手数料_日付(yyyymmddで現在の日付) 

#抽出条件
x列にデータあり または AA列にデータあり

#コピーする列は、式でなく値をコピーする
x列、W列、AA列、Z列

コメントを投稿

0 コメント