前提・実現したいこと
VBAを使用してUSBに特定のファイルをコピーしたい
ここに質問の内容を詳しく書いてください。
VBAを使用して、USBへ特定のファイルをコピーできるものを作成しようと思います。
実装自体はできている任氏なのですが、ファイルが見つかりませんのエラーが発生します。
発生している問題・エラーメッセージ
実行時エラー 53 ファイルが見つかりません。
該当のソースコード
VBA
1Sub mkCopyFolder() 2 Dim myFSO As Object 3 Dim FrFolder As Object 4 Dim Path1 As String '作成予定フォルダの上位パス1 5 Dim FileName As String 6 Dim Dr As Object, Dl As String, Dv As String 7 Dim Usename As String 8 Dim RealFolder As String 9 Dim UseFolder As String 10 Dim ret As Long 11 12 Path1 = Range("C3").Value 13 Usbname = Range("B3").Value + "" 14 FileName = Range("B6").Value 15 RealFolder = Path1 & "¥" & FileName 16 17 Set myFSO = CreateObject("Scripting.FilesystemObject") 18 Dl = "" 19 For Each Dr In myFSO.Drives 20 Dv = "" 21 On Error Resume Next 22 Dv = Dr.VolumeName 23 On Error GoTo 0 24 25 If Dv <> "" Then 26 If Dr.VolumeName = Usbname Then 27 Dl = Dr.DriveLetter 28 Exit For 29 End If 30 End If 31 Next Dr 32 33 If Dl <> "" Then 34 UsbFolder = Dl & ":¥" 35 If Dir(UsbFolder) <> "" Then 36 ret = MsgBox("同じ名前のファイルがあります。" & vbCrLf & _ 37 "上書きしていいよね??", vbYesNo) 38 If ret = vbNo Then Exit Sub 39 End If 40 With New FileSystemObject 41.CopyFile RealFolder, UsbFolder, True ←この部分でエラーが発生 42 End With 43 MsgBox "USBメモリーへ" & FileName & "コピーしました" 44 Else 45 MsgBox "USBメモリがセットされていません" 46 End If 47 Set myFSO = Nothing 48 Set FrFolder = Nothing 49 Set Dr = Nothing 50End Sub 51
試したこと
実際に存在することは画面上で確認していて、
デバックでもPASS表示に問題ないことを確認しています。
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
Excel2016を使用しています。