Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9718 / 76734 ←次へ | 前へ→

【72575】Re:指定フォルダ配下の全ファイルコピー
お礼  FSO初心者  - 12/8/26(日) 0:36 -

引用なし
パスワード
   ▼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

3 hits

【72554】指定フォルダ配下の全ファイルコピー FSO初心者 12/8/23(木) 22:40 質問
【72555】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/23(木) 23:36 発言
【72561】Re:指定フォルダ配下の全ファイルコピー FSO初心者 12/8/24(金) 23:40 お礼
【72556】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/24(金) 0:19 発言
【72557】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/24(金) 11:33 発言
【72562】Re:指定フォルダ配下の全ファイルコピー FSO初心者 12/8/24(金) 23:48 お礼
【72564】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/25(土) 8:23 発言
【72565】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/25(土) 9:05 発言
【72566】Re:指定フォルダ配下の全ファイルコピー Yuki 12/8/25(土) 9:37 発言
【72569】Re:指定フォルダ配下の全ファイルコピー FSO初心者 12/8/25(土) 14:56 質問
【72571】Re:指定フォルダ配下の全ファイルコピー Yuki 12/8/25(土) 17:59 発言
【72575】Re:指定フォルダ配下の全ファイルコピー FSO初心者 12/8/26(日) 0:36 お礼
【72589】Re:指定フォルダ配下の全ファイルコピー Yuki 12/8/26(日) 19:55 発言
【72572】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/25(土) 19:01 発言
【72588】Re:指定フォルダ配下の全ファイルコピー FSO初心者 12/8/26(日) 19:04 回答
【72558】Re:指定フォルダ配下の全ファイルコピー kanabun 12/8/24(金) 11:39 発言

9718 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free