|
題名の通りですが、
指定したフォルダ配下の、サブフォルダー内も含むすべてのファイルを、
指定フォルダ内へコピーするマクロを作りたいです。
FileSystemObject初心者なのですが、WEBページを参考にぱっと書き上げたものでは
うまくいきません。(というよりコンパイルエラーから抜け出せません。。)
何か良い方法はありますでしょうか?
(以下のは私の駄作コードです。参考までに。
なお、以下のコードでは動いたとしても
指定フォルダ配下第一階層までしかコピーできないと思います。)
【ご回答にあたって】
下記コードを活かす活かさないはどちらでもよいのですが、
お時間あれば、後学のためにご質問にもご回答いただければと思います。
1.FileSystemObjectの使用方法として、下記のように3つもインスタンス生成
するのは根本的に間違っていませんか?
2.FileSystemObjectではなく、Microsoftscriptingruntimeで使用可能になった
Folder、Fileオブジェクトでフルパスの取得はできますか?
(もしできるなら、FileSystemObjectとの差異はなんでしょうか?
メソッドやプロパティの違い?)
以上、
ご面倒ですが、小生にご指南いただけると幸いです。
ーーーーー(Microsoft scripting runtime はオンにしています。)
Sub filemove()
Dim BeforePath As String, AfterPath As String
BeforePath = ThisWorkbook.Worksheets(1).Range("A1") 'コピー元フォルダの指定
AfterPath = ThisWorkbook.Worksheets(1).Range("2") & "\" 'コピー先フォルダの指定
Dim objpath As Folder, objfile As File 'For Eachで使用するためのハコ
Dim objFSO1 As FileSystemObject, objFSO2 As FileSystemObject
Set objFSO1 = New FileSystemObject '指定フォルダ配下のサブフォルダ取得用
Set objFSO2 = New FileSystemObject 'サブフォルダ内のファイル取得用
For Each objpath In objFSO1.GetFolder(BeforePath).SubFolders
For Each objfile In objpath.Files
Const cnsSOUR = objFSO2.GetAbsolutePathName(objfile)
Const cnsDEST = AfterPath & objfile.Name
Dim objFSO3 As FileSystemObject 'ファイルコピー用
Set objFSO3 = New FileSystemObject
objFSO3.MoveFile cnsSOUR, cnsDEST
Next objfile
Next objpath
Set objFSO1 = Nothing
Set objFSO2 = Nothing
Set objFSO3 = Nothing
End Sub
ーーーーーーーーーーーー
※GetAbsolutePathNameの定数が設定されていないとかいうエラーから進めません。
|
|