|
▼Yuki さん:
じっくりと読ませていただきました。すごいです。最初のプロシージャを必要となるFSOの生成と条件設定にしておく。そして本処理のEnumプロシージャは1.フォルダ内ファイルのコピー→2.全サブ内のための同プロシージャのForEach呼出し。こういう秀逸な構成をぱっと思いつきたいものです。
(なお、たった一部のみ、誤り箇所がありましたので、僭越ながら下記引用にて修正をご案内させていただきます。★箇所をご確認ください。)
構成からFSOの書き方まで非常に勉強になりました。どうもありがとうございました。
(私のFSOへの疑問の一つのFSOの生成数について、Yukiさんのコードは無駄なく一つのFSOを使ってらっしゃるところから、私の書き方はやはりいいコードではなかったと言えそうです。)
>▼FSO初心者 さん:
>>>>もしサブルーティン等のコードで、指定配下全サブ内含む全ファイルをコピーできるいいの書き方があればご教授いただければと思います。
>
>>
>>同名のファイルはないです。ただ、同名が出てきたら確かに厄介ですね。。ファイル名を変えてコピーとか厳しそうですね。
>ファイル名に出現回数を付加してCopyしています。
>CopyFile -> MoveFile ?
>
>Sub CallFilePathListA()
> Dim FSO As Object
> Dim BeforePath As String 'コピー元フォルダパス
> Dim AfterPath As String 'コピー先フォルダパス
> Dim strF As String
> Dim i As Long
>
> strF = "*.XLS"
> BeforePath = "D:\Excel\CopyA\" ' セルの値に変更してね。
> AfterPath = "D:\Excel\CopyB\" ' セルの値に変更してね。
>
> Set FSO = CreateObject("Scripting.FileSystemObject")
> Call EnumFilePathListA(FSO, FSO.GetFolder(BeforePath), _
> strF, AfterPath)
>End Sub
>
>Sub EnumFilePathListA(FSO As Object, objFolder As Object, _
> strF As String, AfterPath As String)
> Dim objfile As Object
> Dim objSubDir As Object
> Dim fNm As String
> Dim pNm As String
> Dim vfNm As Variant
> Dim i As Long
>
> 'ファイル名を列挙
> On Error Resume Next
> For Each objfile In objFolder.Files
> If UCase(objfile.Path) Like strF Then
> fNm = Dir(AfterPath & objfile.Name)
> If fNm <> "" Then ' 同名のファイル名
> i = 0
> vfNm = Split(objfile.Name, ".") '. で分解
> pNm = vfNm(0)
> Do
> vfNm(0) = pNm & i ' ファイル名に数値を+
> i = i + 1
> fNm = Dir(AfterPath & Join(vfNm, ".")) ' 又同じか?
> If fNm = "" Then ' 同じでなかったら
★ fNm = Join(vfNm, ".") '元「fNm = AfterPath & Join(vfNm, ".")
★''後続のコピーメソッドの際に、AfterパスとfNmのパスが重複してしまいますので、ここのでfNmはファイル名だけ(Joinのみ)に修正しております。
> Exit Do
> End If
> Loop
> FSO.CopyFile objfile.Path, AfterPath & fNm
>' Debug.Print objfile.Path, AfterPath & fNm
> Else
> FSO.CopyFile objfile.Path, AfterPath & objfile.Name
>' Debug.Print objfile.Path, AfterPath & objfile.Name
> End If
> End If
> Next
> 'サブフォルダを検索
> For Each objSubDir In objFolder.SubFolders
> Call EnumFilePathListA(FSO, objSubDir, strF, AfterPath)
> Next
>End Sub
|
|