VBAで、同一フォルダの複数ファイルに対し「backup」フォルダを同

VBAで、同一フォルダの複数ファイルに対し「backup」フォルダを同じディレクトリに作成した上で、全ファイルをそこへコピーするソースを教えていただけますでしょうか？

No.2 ベストアンサー 回答者： ka_na_de 回答日時： 2010/02/24 20:48

こんばんは。

一例です。

Sub test()
　　Dim myFolderName As String
　　Dim myFolderCheck As String
　　Dim myFileName As String

　　myFolderName = "backup"
　　
　　myFolderCheck = Dir(ThisWorkbook.Path & "\" & myFolderName, vbDirectory)
　　If myFolderCheck = "" Then
　　　　MkDir ThisWorkbook.Path & "\" & myFolderName
　　End If
　　
　　myFileName = Dir(ThisWorkbook.Path & "\*.*", vbNormal)
　　Do Until myFileName = ""
　　　　If myFileName <> ThisWorkbook.Name Then
　　　　　　FileCopy myFileName, myFolderName & "\" & myFileName
　　　　End If
　　　　myFileName = Dir()
　　Loop

End Sub

No.1 回答者： quicon9ue 回答日時： 2010/02/24 20:40

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(".\backup") = False Then
fso.CreateFolder (".\backup")
End If
For Each afile In fso.GetFolder(".").Files
fso.CopyFile afile.Path, fso.GetParentFolderName(afile) & "\backup\"
Next

ご要望はこんな感じでしょうか？
メモ帳にはりつけて、拡張子vbsで同じフォルダに保存し、実行してください。
Excel等のVBAでやるなら、ThisWorkBook.Pathとかに書き換えて、絶対パスにしてください。"."は使えません。