コピー＆リネームするには？

kou 2009-02-06 18:49:42 No: 141467

こんにちは。あるフォルダの中に、物件ごとにフォルダを作って各物件データを保存していきます。各物件データには同名ファイルが存在し（例：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

KG 2009-02-07 07:07:07 No: 141468

フォルダを走査しながら重複かどうかを判断するのは難しいと思われます。

まず、重複しているファイル名を特定してから、コピー。という流れに
パッと思いつくのは

１．ファイル名をテキストに出力
２．出力内容をソート
３．重複ファイル名を抽出

という流れでしょうか。
ファイル、フォルダのコピー等で処理するなら

-----------------------------
コピー元
  ├物件1
  ｜  ├ABC.xls
  ｜  └DEF.xls
  ├物件2
  ｜  ├ABC.xls
  ｜  └GHI.xls
  └物件3
      ├DEF.xls
      └XYZ.xls
----------------------
を
----------------------

一時ディレクトリ
  ├ABC
  ｜  ├物件1_ABC.xls
  ｜  └物件2_ABC.xls
  ├DEF
  ｜  ├物件2_DEF.xls
  ｜  └物件3_DEF.xls
  ├GHI
  ｜  └物件2_GHI.xls
  └XYZ
      └物件3_XYZ.xls
-------------------------------
にできれば、FileSystemObjectとFolderオブジェクトで
実現できそうですねぇ、.Files.Countプロパティもありますし。

ああ、なんかこういうの考えてて楽しい。