VBSで指定した日付のファイルのみを抽出するには

質問

以下の内容について教えていただけないでしょうか？

○実施したいこと
・インプットボックスに日付を入力
・指定したフォルダに移動
・インプットボックスで入力された日付を含むファイルのみ抽出
　(ファイル名：　**130503**)
→ファイルは０個、１個、複数個の場合あり
・抽出したファイルを別フォルダにコピー

○困っていること
・入力した日付をパラメータとして、ファイル検索を行い該当するファイルを
　抽出する方法
※入力する日付は130503のようにしたいです。

○現在、作成中のソース

Option Explicit
Dim hizuke
Dim fs

Do
'日付を入力するためのインプットボックスを表示
hizuke = InputBox("日付を入力してください。" &_
vbCR & vbCR &_
"例）2000/01/01")

'「キャンセル」または未入力で終了
If hizuke = "" Then
Exit Do

'正しい日付が入力された場合
ElseIf IsDate(hizuke) then
MsgBox "テスト（正しい日付が入力されました。）"

'オブジェクトを作成する
Set fs = CreateObject("Scripting.FileSystemObject")
'ファイルをコピーする
fs.CopyFile "D:\test130503.log","D:\test\"

'日付でなかったら、注意を表示して、インプットボックスに戻る
Else
MsgBox "入力した値が不正です。"
End If

Loop

宜しくお願いします。

回答No.2

DOUGLAS_ · ベストアンサー

いろいろな分岐点を設けてみました。
　検証して、理解しながらお試しください。

Dim hizuke, fs, msg, f
Const copyFrom = "D:\"
Const copyTo = "D:\test\"
Do
      hizuke = InputBox("日付を入力してください。" & vbCr & vbCr & "例）2000/01/01 → 000101")
      If hizuke = "" Then Exit Do
      If Len(hizuke) = 6 Then
          On Error Resume Next
          hizuke = CDate("20" & Left(hizuke, 2) & "/" & Mid(hizuke, 3, 2) & "/" & Right(hizuke, 2))
          If Err.Number = 0 Then
              On Error GoTo 0
              msg = MsgBox(FormatDateTime(hizuke, 2) & "でよろしいか ", vbYesNoCancel)
              If msg = 6 Then
                  Set fs = CreateObject("Scripting.FileSystemObject")
                  For Each f In fs.GetFolder(copyFrom).Files
                      If InStr(f.Name, Replace(Right(hizuke, 8), "/", "")) > 0 Then
                          If fs.FileExists(copyTo & f.Name) Then
                              If MsgBox(f.DateLastModified _
                                  & " 更新の「" & f.Path & "」を" & vbCr _
                                  & fs.GetFile(copyTo & f.Name).DateLastModified _
                                  & " 更新の「" & copyTo & f.Name & "」に" & vbCr _
                                  & "上書きしてよろしいか ", vbYesNoCancel) = 6 Then
                                  fs.CopyFile f.Path, copyTo
                              End If
                          Else
                              fs.CopyFile f.Path, copyTo
                          End If
                      End If
                  Next
                  Set fs = Nothing
                  Exit Do
              ElseIf msg = 2 Then Exit Do
              End If
          Else
              On Error GoTo 0
              MsgBox "入力した値が不正です。"
          End If
      Else
          MsgBox "入力した値が不正です。"
      End If
Loop

お礼

ありがとうございます。行いたいことができました。検証しながら理解を深めさせていただきます。

回答No.1

notnot

＞入力した日付をパラメータとして、ファイル検索を行い該当するファイルを抽出する方法

直接そういうことはできないので、フォルダの全ファイルを列挙して、条件に合う物をifで選択してください。

全ファイル列挙は
http://msdn.microsoft.com/ja-jp/library/cc427964.aspx
あたりを参考にしてください。

お礼

ありがとうございます。Fileコレクションを使用してソースを組んでみます。