コピー＆リネームするには？ (ID:141467)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 こんにちは。あるフォルダの中に、物件ごとにフォルダを作って各物件データを保存していきます。各物件データには同名ファイルが存在し（例：ABC.xls）、そのABC.xlsファイルのみ別のフォルダにコピーしたいと思います。同名ですのでコピーする時にリネームも同時に行いたいのですが、リネームルールは【親フォルダ名_元ファイル名】にしたいと考えています。対象ファイルは全て、各物件フォルダの第一階層に格納されています。以下、現時点で考えれているところまで記載しますが、これではABC.xls以外のファイルもコピーされてしまって行き詰っています。宜しくお願いいたします。 Sub try() Dim FSO Dim Folname Dim Fname Dim Cpname As String Dim Psname As String Dim v, vv Cpname = "コピー元の親フォルダ" ' Psname = "コピー先のフォルダ" ' 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