Excel VBA質問箱 IV

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

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


1693 / 13645 ツリー ←次へ | 前へ→

【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 発言[未読]

【72554】指定フォルダ配下の全ファイルコピー
質問  FSO初心者  - 12/8/23(木) 22:40 -

引用なし
パスワード
   題名の通りですが、
指定したフォルダ配下の、サブフォルダー内も含むすべてのファイルを、
指定フォルダ内へコピーするマクロを作りたいです。

FileSystemObject初心者なのですが、WEBページを参考にぱっと書き上げたものでは
うまくいきません。(というよりコンパイルエラーから抜け出せません。。)

何か良い方法はありますでしょうか?

(以下のは私の駄作コードです。参考までに。
 なお、以下のコードでは動いたとしても
 指定フォルダ配下第一階層までしかコピーできないと思います。)

【ご回答にあたって】
下記コードを活かす活かさないはどちらでもよいのですが、
お時間あれば、後学のためにご質問にもご回答いただければと思います。
1.FileSystemObjectの使用方法として、下記のように3つもインスタンス生成
 するのは根本的に間違っていませんか?
2.FileSystemObjectではなく、Microsoftscriptingruntimeで使用可能になった
 Folder、Fileオブジェクトでフルパスの取得はできますか?
 (もしできるなら、FileSystemObjectとの差異はなんでしょうか?
  メソッドやプロパティの違い?)

以上、
ご面倒ですが、小生にご指南いただけると幸いです。


ーーーーー(Microsoft scripting runtime はオンにしています。)

Sub filemove()
Dim BeforePath As String, AfterPath As String

BeforePath = ThisWorkbook.Worksheets(1).Range("A1") 'コピー元フォルダの指定
AfterPath = ThisWorkbook.Worksheets(1).Range("2") & "\" 'コピー先フォルダの指定
Dim objpath As Folder, objfile As File 'For Eachで使用するためのハコ

Dim objFSO1 As FileSystemObject, objFSO2 As FileSystemObject
Set objFSO1 = New FileSystemObject '指定フォルダ配下のサブフォルダ取得用
Set objFSO2 = New FileSystemObject 'サブフォルダ内のファイル取得用
  
  For Each objpath In objFSO1.GetFolder(BeforePath).SubFolders
    For Each objfile In objpath.Files
      Const cnsSOUR = objFSO2.GetAbsolutePathName(objfile)
      Const cnsDEST = AfterPath & objfile.Name
    
      Dim objFSO3 As FileSystemObject 'ファイルコピー用
      Set objFSO3 = New FileSystemObject
      objFSO3.MoveFile cnsSOUR, cnsDEST
    Next objfile
  Next objpath
  
  Set objFSO1 = Nothing
  Set objFSO2 = Nothing
  Set objFSO3 = Nothing

End Sub

ーーーーーーーーーーーー
※GetAbsolutePathNameの定数が設定されていないとかいうエラーから進めません。

【72555】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/23(木) 23:36 -

引用なし
パスワード
   ▼FSO初心者 さん:

全体はみてないのですが、

>※GetAbsolutePathNameの定数が設定されていないとかいうエラーから進めません。

>      Const cnsSOUR = objFSO2.GetAbsolutePathName(objfile)
>      Const cnsDEST = AfterPath & objfile.Name

このエラーは 右辺で変数を使って 定数を定義しようとしているので
構文エラーが起きているのだと思います。
単純に、

    Dim SrcPath As String
    Dim DestPath As String
      SrcPath = objFSO2.GetAbsolutePathName(objfile)
      DestPath = AfterPath & objfile.Name

のように、変数に代入するようにしたら、いかがですか?

【72556】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/24(金) 0:19 -

引用なし
パスワード
   ▼FSO初心者 さん:

>指定したフォルダ配下の、サブフォルダー内も含むすべてのファイルを、
>指定フォルダ内へコピーするマクロを作りたいです。

Fso は使ってません。代わりに DOSのXCOPYというコマンドで
処理をしています。

Sub try_XCopy()
  Dim SrcPath As String:  SrcPath = "D:\(Data)"
  Dim DestPath As String:  DestPath = "D:\(Temp)"
  Dim tmpPath As String
  Dim sCmd As String
  Dim ok As Long
  
  tmpPath = Environ$("Temp") & "\Dir.tmp"  '一時ファイルパス
  If Right$(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
  sCmd = "XCopy " & SrcPath & " " & DestPath _
      & " /s /e /c /h /r /k > """ & tmpPath & """"
  ok = CreateObject("WScript.Shell") _
    .Run("%ComSpec% /C " & sCmd, 7, True) 'DOSコマンド実行
  
  MsgBox "Copyが終了しました"
  
End Sub

【72557】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/24(金) 11:33 -

引用なし
パスワード
   Runメソッドは成功すれば 0 を、失敗するとエラー番号を
返すので、上のコード最後の部分も


  If ok > 0 Then
    MsgBox "失敗しました #" & ok
  Else
    MsgBox "Copyが終了しました"
  End If

としたほうが親切かな?

【72558】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/24(金) 11:39 -

引用なし
パスワード
   もひとつ補足で。

コマンドは
> sCmd = "XCopy " & SrcPath & " " & DestPath _
      & " /s /e /c /h /r /k > """ & tmpPath & """"
として Temp フォルダにコピーしたフォルダ名、ファイル名を
記録しています。
テキストファイルですから メモ帳で読めます。
場所は
C:\Users\ユーザー名\AppData\Local\Temp\Dir.tmp
です(Win7 のばあい)

場所が分からない場合は
> tmpPath = Environ$("Temp") & "\Dir.tmp"  '一時ファイルパス
のあとに
  Debug.Print tmpPath
として、イミディエイト・ウィンドウでパスを確認してください。

【72561】Re:指定フォルダ配下の全ファイルコピー
お礼  FSO初心者  - 12/8/24(金) 23:40 -

引用なし
パスワード
   ▼kanabun さん:
>▼FSO初心者 さん:
>
>全体はみてないのですが、
>
>>※GetAbsolutePathNameの定数が設定されていないとかいうエラーから進めません。
>
>>      Const cnsSOUR = objFSO2.GetAbsolutePathName(objfile)
>>      Const cnsDEST = AfterPath & objfile.Name
>
>このエラーは 右辺で変数を使って 定数を定義しようとしているので
>構文エラーが起きているのだと思います。
>単純に、
>
>    Dim SrcPath As String
>    Dim DestPath As String
>      SrcPath = objFSO2.GetAbsolutePathName(objfile)
>      DestPath = AfterPath & objfile.Name
>
>のように、変数に代入するようにしたら、いかがですか?


変数に値を格納するやり方で、ちゃんと動きました!
どうもありがとうございます。
(FSOではなくconst構文のエラーだったんですね。。)
 
ただ動くようになったといっても指定フォルダ配下第一までしか参照しない
コードになっているので不完全ではあるなあという感じですね。


もしよろしければ後学のために質問にもお答えいただければ幸いです。

1.FileSystemObjectの使用方法として、私のコードのように3つもインスタンス生成
 するのは根本的に間違っていませんか?
2.FileSystemObjectではなく、Microsoftscriptingruntimeで使用可能になった
 Folder、Fileオブジェクトでフルパスの取得はできますか?
 (もしできるなら、FileSystemObjectとの差異はなんでしょうか?
  その他のメソッドやプロパティの違い?)

【72562】Re:指定フォルダ配下の全ファイルコピー
お礼  FSO初心者  - 12/8/24(金) 23:48 -

引用なし
パスワード
   ▼kanabun さん:
>Runメソッドは成功すれば 0 を、失敗するとエラー番号を
>返すので、上のコード最後の部分も
>
>
>  If ok > 0 Then
>    MsgBox "失敗しました #" & ok
>  Else
>    MsgBox "Copyが終了しました"
>  End If
>
>としたほうが親切かな?

上記にて処理の判定をしたのですが、なぜか返り値が0以外の失敗になってしまいます。記載頂いたコードをコピペしても、当方残念ながらDOSコマンドのVBA記述はさっぱりでして。。。(WEBにてDOSコマンド1行程度で指定配下の全ファイル(全サブフォルダ内の)を簡単にコピーできるソースが複数見つかりますが、そちらをDOS窓で試してみてもやはりうまくいきませんでした。やはり私に原因があるのでしょうか。。)


他の方のヒントにて、私のコードで1階層までのサブフォルダ内にある全ファイルはコピーできたので、一旦そのコードで代用しました。

もしサブルーティン等のコードで、指定配下全サブ内含む全ファイルをコピーできるいいの書き方があればご教授いただければと思います。

どうもありがとうございました。

【72564】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/25(土) 8:23 -

引用なし
パスワード
   ▼FSO初心者 さん:

> 上記にて処理の判定をしたのですが、
> なぜか返り値が0以外の失敗になってしまいます。
エラー番号は何番が返りましたか? # 4 ですか?

>  Dim SrcPath As String:  SrcPath = "D:\(Data)"
>  Dim DestPath As String:  DestPath = "D:\(Temp)"
>
>  sCmd = "XCopy " & SrcPath & " " & DestPath _
>      & " /s /e /c /h /r /k > """ & tmpPath & """"

サンプルコードでは
> SrcPath = "D:\(Data)"
> DestPath = "D:\(Temp)"
のような、パス名の中に スペースを含まない簡単な例を示しましたが、
実際のパス名(コピー元、コピー先のいずれかまたは両方)に
スペースが含まれていれば、コマンド文字列は、「パス名を""で
囲う」処理を付け加えないと、これだけで、失敗しますね。
(他にも 失敗する原因はあると思うので、エラー番号が
 どのような内容のエラーに対応するのか、調べてみるとよい
 かもしれません)

XCopy コマンドはサブフォルダも作成しながらFileCopyしてくれます
ので、 FsoやVBA組み込みメソッド には相当するものが無い高機能な
ツールです。
オプションのセットにより、フォルダだけコピーとか、特定の文字列
を含むファイルまたはフォルダを「コピーから除外」したり、とか
日付けが新しいものだけバックアップ目的でコピーさせたり、とか
このコマンド一つでいろんなことができます。

ぼく自身はFSOは鈍足であまり使わないので、Fsoのほうの疑問には
お答えできませんが、そちらの疑問が解決したら、ぜひ XCopy コマ
ンド に再挑戦してみることをお勧めします♪

【72565】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/25(土) 9:05 -

引用なし
パスワード
   (補足)
XCOPYコマンドが終了時に返す数値
--- ------------------------------------
0 正常に終了した
1 複写すべきファイルが見つからなかった
2 Breakキーによる中断
4 初期化エラー。メモリ/ディスク容量不足、
  または無効なドライブ名や構文が指定された
5 ディスク書き込みエラーが発生した

【72566】Re:指定フォルダ配下の全ファイルコピー
発言  Yuki  - 12/8/25(土) 9:37 -

引用なし
パスワード
   ▼FSO初心者 さん:
>もしサブルーティン等のコードで、指定配下全サブ内含む全ファイルをコピーできるいいの書き方があればご教授いただければと思います。
>
質問です。
サブフォルダ内には同名のファイルはないのですか?
あった場合はどのような処理をされるのでしょうか?
又、 MoveFile とありますが移動で宜しいのでしょうか?

【72569】Re:指定フォルダ配下の全ファイルコピー
質問  FSO初心者  - 12/8/25(土) 14:56 -

引用なし
パスワード
   ▼Yuki さん:
>▼FSO初心者 さん:
>>もしサブルーティン等のコードで、指定配下全サブ内含む全ファイルをコピーできるいいの書き方があればご教授いただければと思います。
>>
>質問です。
>サブフォルダ内には同名のファイルはないのですか?
>あった場合はどのような処理をされるのでしょうか?
>又、 MoveFile とありますが移動で宜しいのでしょうか?


同名のファイルはないです。ただ、同名が出てきたら確かに厄介ですね。。ファイル名を変えてコピーとか厳しそうですね。
当初は移動を考えてたのですが途中コピーに変更したのをタイトル変更し忘れました。


全サブ且つ同名ファイル対応を踏まえて、どうしたらよいでしょうか?(私のは第一サブのみで同名ファイルはエラーになってしまいますね。。)

【72571】Re:指定フォルダ配下の全ファイルコピー
発言  Yuki  - 12/8/25(土) 17:59 -

引用なし
パスワード
   ▼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 = AfterPath & Join(vfNm, ".")
            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

【72572】Re:指定フォルダ配下の全ファイルコピー
発言  kanabun  - 12/8/25(土) 19:01 -

引用なし
パスワード
   ▼FSO初心者 さん:

>同名のファイルはないです。ただ、同名が出てきたら確かに厄介ですね。。ファイル名を変えてコピーとか厳しそうですね。

同名のファイルといっても、別フォルダでしょ?
どうして問題あるんですか?


[Source]
FolderA
 ┃   abc.xls
 ┃   xyz.xls
 ┣━SubB
 ┃   abc.xls
 ┃   xyz.xls
 ┃
 ┣━SubC
 ┃ │  abc.xls
 ┃ │  klm.xls
 ┃ │  xyz.xls
 ┃ │
 ┃ ├─SubDD
 ┃ │   abc.xls
 ┃ │   klm.xls
 ┃ │   xyz.xls

と、ツリーがあったとして、
これを 別フォルダにサブフォルダの構成そのままでコピー
したいんでしょ??

[Dest]
BackUpFolder
 ┃   abc.xls
 ┃   xyz.xls
 ┣━SubB
 ┃   abc.xls
 ┃   xyz.xls
 ┃
 ┣━SubC
 ┃ │  abc.xls
 ┃ │  klm.xls
 ┃ │  xyz.xls
 ┃ │
 ┃ ├─SubDD
 ┃ │   abc.xls
 ┃ │   klm.xls
 ┃ │   xyz.xls

【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

【72588】Re:指定フォルダ配下の全ファイルコピー
回答  FSO初心者  - 12/8/26(日) 19:04 -

引用なし
パスワード
   ▼kanabun さん:
フォルダはコピーせずファイルだけを一つのフォルダにコピーしたかったんです。なのて別フォルダ同名のファイルは名前を変える必要があるのです。

お伝えが下手ですみませんてした。


>▼FSO初心者 さん:
>
>>同名のファイルはないです。ただ、同名が出てきたら確かに厄介ですね。。ファイル名を変えてコピーとか厳しそうですね。
>
>同名のファイルといっても、別フォルダでしょ?
>どうして問題あるんですか?
>
>
>[Source]
>FolderA
> ┃   abc.xls
> ┃   xyz.xls
> ┣━SubB
> ┃   abc.xls
> ┃   xyz.xls
> ┃
> ┣━SubC
> ┃ │  abc.xls
> ┃ │  klm.xls
> ┃ │  xyz.xls
> ┃ │
> ┃ ├─SubDD
> ┃ │   abc.xls
> ┃ │   klm.xls
> ┃ │   xyz.xls
>
>と、ツリーがあったとして、
>これを 別フォルダにサブフォルダの構成そのままでコピー
>したいんでしょ??
>
>[Dest]
>BackUpFolder
> ┃   abc.xls
> ┃   xyz.xls
> ┣━SubB
> ┃   abc.xls
> ┃   xyz.xls
> ┃
> ┣━SubC
> ┃ │  abc.xls
> ┃ │  klm.xls
> ┃ │  xyz.xls
> ┃ │
> ┃ ├─SubDD
> ┃ │   abc.xls
> ┃ │   klm.xls
> ┃ │   xyz.xls

【72589】Re:指定フォルダ配下の全ファイルコピー
発言  Yuki  - 12/8/26(日) 19:55 -

引用なし
パスワード
   ▼FSO初心者 さん:

どうもです。
検証不足ですみませんでしたね。
でも、御自分で修正されたのはすばらしい解読力ですねですね
頑張ってください。

>(なお、たった一部のみ、誤り箇所がありましたので、僭越ながら下記引用にて修正をご案内させていただきます。★箇所をご確認ください。)
>
>>          If fNm = "" Then  >
>★            fNm = Join(vfNm, ".") '元「fNm = AfterPath & Join(vfNm, ".") 
>★''後続のコピーメソッドの際に、AfterパスとfNmのパスが重複してしまいますので、ここのでfNmはファイル名だけ(Joinのみ)に修正しております。
>>            Exit Do
>>          End If
>>        Loop
         ’ここで付加しているの上記記述では2重付加になってしまいますね。
>>        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

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