コピー＆リネーム

質問

こんにちは。仕事で大量の反復作業があるため、マクロでの自動処理を考えています。ＶＢの参考図書を見ながら挑戦してみたのですが、何分初めてなものでなかなかうまくいきません・・・もう時間が無いので、お恥ずかしいのですが教えて頂けないでしょうか。宜しくお願いいたします。
【処理内容】複数のフォルダがあり、各フォルダの同じ階層位置に同名ファイルが存在します。それらを全て一つのフォルダにまとめてコピーするのですが、同名ファイルなのでコピーの際にリネーム処理も同時に行いながらコピーします。リネームのルールは、「親フォルダ名_元ファイル名.元拡張子」です。

回答No.2

n-jun · ベストアンサー

＃１です。

FileSystemObjectの解説(目次)
http://www.officetanaka.net/excel/vba/filesystemobject/index.htm

を参考に初めて作った物ですので正解でないかも知れませんが、ご希望の動きは
している事は検証できました。

コピー元・コピー先のフォルダを修正して下さい。

Sub try()
Dim FSO
Dim Folname
Dim Fname
Dim Cpname As String
Dim Psname As String
Dim v, vv

Cpname = "R:\bbb" ' コピー元の親フォルダ
Psname = "R:\bbb" ' コピー先のフォルダ

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each Folname In FSO.GetFolder(Cpname).SubFolders
For Each Fname In FSO.GetFolder(Folname).Files

v = Split(Folname, "\")
vv = Split(Fname, "\")
FSO.GetFile(Fname).Copy Psname & "\" & v(UBound(v)) & "_" & vv(UBound(vv))

Next
Next
Set FSO = Nothing
End Sub

ご参考になれば。

お礼

n-junさん。完璧です！！ありがとうございました！助かりました（＾－＾）

回答No.1

n-jun

”マクロ”で”ＶＢ”と言う事は、どのアプリなのでしょう。
Excel　or　Access　とか。
ＶＢ．ＮＥＴとか。

＞初めてなものでなかなかうまくいきません
提示してみては如何でしょう。
そこを修正する事で、間違っていた部分を理解出来るかと思います。

補足

すみません、Excelのマクロで考えています。マクロってExcelに限った話ではないんですね・・・お恥ずかしいです。