こんばんは。宜しくお願いします。
◇行いたいこと
複数のフォルダ(例:"D:\AB" "D:\CD" "D:\EF")に格納されているファイルの中から指定した
日付を含んだファイルをコピーし、あるフォルダに張り付けたい。
(指定する日付を含んだファイルがすべてのフォルダに存在するとは限らない)
◇現時点でのソース
※エラー処理の未実装部分については無視していただいてけっこうです。
Dim fs
Dim msg
Dim f
Const copyFrom = "D:\AB"
Const copyTo = "D:\VBS\コピー先\"
Do
'日付入力のインプットボックスを出力
hizuke = InputBox("日付を入力してください。" & vbCr & vbCr & "例)2000-01-01")
'インプットボックスの入力値が空白である
If hizuke = "" Then
'日付入力を促すメッセージ出力
MsgBox "日付を入力してください。"
Exit Do
End If
'インプットボックスの入力値が10文字である
If Len(hizuke) = 10 Then
'エラーが発生しても次の処理をすすめる
On Error Resume Next
'指定した日付の確認ダイアログを表示
msg = MsgBox(hizuke & "でよろしいですか?", vbYesNoCancel)
'日付の確認ダイアログでYesを選択
If msg = vbYes Then
'ファイルオブジェクトを作成
Set fs = CreateObject("Scripting.FileSystemObject")
'コピー元フォルダに存在するファイルを読み込む
For Each f In fs.GetFolder(copyFrom).Files
'指定した日付を含むファイル名を検索
If InStr(f.Name, hizuke) > 0 Then
'未実装 ファイルの上書き処理
fs.CopyFile 'コピー元 コピー先
Exit Do
'未実装 Else Ifの処理
End If
Next
'未実装 Else Ifの処理
End If
'未実装 Else Ifの処理
End If
Loop
以上です。ご教授宜しくお願いします。
No.2ベストアンサー
- 回答日時:
こんな感じでイケルかと存じますが、内容をよく吟味してから、実情に応じてコードを書き換えてみてください。
Option Explicit
Dim fs, f, msg, copyFrom, c
Dim hizuke, hizuke8, hizuke8h, hizuke8p, hizuke6, hizuke6h, hizuke6p, h
Const copyTo = "D:\VBS\コピー先\"
copyFrom = Array("D:\AB", "D:\CD", "D:\EF")
'日付の確定
Do
hizuke = InputBox("日付を入力してください。" & vbCr & vbCr & "例)2000-01-01")
If hizuke = "" Then WScript.Quit
If Len(hizuke) > 5 Then
If Left(hizuke, 2) <> "20" Then hizuke = "20" & hizuke
hizuke = Replace(hizuke, ".", "/")
On Error Resume Next
hizuke = FormatDateTime(hizuke, vbShortDate)
If Err.Number = 0 Then
If Year(hizuke) > 1999 Then
If MsgBox(FormatDateTime(hizuke, vbLongDate) & "でよろしいか?", vbYesNoCancel) = vbYes Then Exit Do
End If
End If
End If
On Error GoTo 0
Loop
'日付文字列の配列
hizuke8 = Replace(hizuke, "/", "")
hizuke8h = Replace(hizuke, "/", "-")
hizuke8p = Replace(hizuke, "/", ".")
hizuke6 = Mid(hizuke8, 3, 6)
hizuke6h = Mid(hizuke8h, 3, 8)
hizuke6p = Mid(hizuke8p, 3, 8)
hizuke = Array(hizuke8, hizuke8h, hizuke8p, hizuke6, hizuke6h, hizuke6p)
'該当するファイルのコピー
Set fs = CreateObject("Scripting.FileSystemObject")
For c = 0 To UBound(copyFrom)
For Each f In fs.GetFolder(copyFrom(c)).Files
For h = 0 To UBound(hizuke)
If InStr(f.Name, hizuke(h)) > 0 Then
On Error Resume Next
fs.CopyFile f.Path, copyTo & f.Name, False
If Err.Number <> 0 Then
'同名のファイルが存在するときは、フォルダ名を冠して保存
fs.CopyFile f.Path, copyTo & Replace(Mid(copyFrom(c), 3, 100), "\", "") & "_" & f.Name, False
End If
On Error GoTo 0
End If
Next
Next
Next
MsgBox "終了しました"
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) InputBoxでキャンセルボタンを押したらファイル自体を閉じたい 3 2022/07/23 17:52
- Visual Basic(VBA) VBA 参照先で選んだファイルをコピーし、出力先に別名で保存したい 8 2022/05/13 20:37
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/06 17:46
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Visual Basic(VBA) あるフォルダーのファイルを違う親フォルダーのサブフォルダーに移したい 11 2023/02/15 19:00
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています 17 2022/12/07 12:03
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
エクセルのハイパーリンクがコ...
-
バッチファイル 別ファイルにリ...
-
vbsでExcelのシートをコピーす...
-
ファイルサーバ上のファイルが...
-
frxファイルの役目
-
パワポでスライドをコピーでき...
-
バッチファイル XCOPYで上書き...
-
FSO.CopyFileでのエラー無視方法
-
エクセル2010、図が大きすぎま...
-
FTPとファイルコピーの違いにつ...
-
エクセルVBAで開いているファイ...
-
バッチファイルのコピーで
-
xcopyでのバッチコピー方法でコ...
-
ラズパイからパソコンにファイ...
-
ドロップボックス内のファイル...
-
SDカードのコピーと再生の仕方...
-
Excel VBAで値コピーが使用でき...
-
VBSで作成したフォルダにファイ...
-
VBSでExcelシートのコピー
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
VBA
-
バッチファイル XCOPYで上書き...
-
エクセルのハイパーリンクがコ...
-
Vba初心者です。下記のコード助...
-
frxファイルの役目
-
バッチファイル 別ファイルにリ...
-
vbsでExcelのシートをコピーす...
-
エクセルVBAで開いているファイ...
-
バッチファイルのコピーで
-
bat 同名ファイルコピー時にリ...
-
同じファイル名 上書きしないフ...
-
ファイルサーバ上のファイルが...
-
エクセル2010、図が大きすぎま...
-
パワポでスライドをコピーでき...
-
[エクセル]コピーするとオブジ...
-
FTPとファイルコピーの違いにつ...
-
FSO.CopyFileでのエラー無視方法
-
アクセス クエリを別のファイ...
-
ファイルをコピーできない
おすすめ情報