Excel VBA質問箱 IV

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

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


75901 / 76732 ←次へ | 前へ→

【5262】Re:指定ディレクトリからファイルを探しコ...
回答  ポンタ  - 03/4/30(水) 17:58 -

引用なし
パスワード
   調べてみたら、ワイルドカードが使えるようなので、
以下のコードでも動きそうです。

Sub test()
  Dim Path1 As String, Path2 As String
  Dim objFs As Object
  Dim objFolder As Object
  '環境に合わせて書き直してください
  Path1 = "C:\My Documents\test1\"
  Path2 = "C:\My Documents\test2\"
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Call MyFileCopy(objFs.GetFolder(Path1), Path2)
End Sub

Sub MyFileCopy(objFolder As Object, Path As String)
  On Error Resume Next
  Dim objFs As Object
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Dim objFile As Object, objSubFolder As Object
  Call objFs.Copyfile(objFolder.Path & "\××××*", Path)
  For Each objSubFolder In objFolder.SubFolders
    Call MyFileCopy(objSubFolder, Path)
  Next
End Sub

ただ、同名のファイルが存在した場合を考慮すると、
以下のようにした方がよいかもしれません。

Sub test()
  Dim Path1 As String, Path2 As String
  Dim objFs As Object
  Dim objFolder As Object
  '環境に合わせて書き直してください
  Path1 = "C:\My Documents\test1\"
  Path2 = "C:\My Documents\test2\"
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Call MyFileCopy(objFs.GetFolder(Path1), Path2)
End Sub

Sub MyFileCopy(objFolder As Object, Path As String)
  On Error Resume Next
  Dim objFs As Object
  Dim objFile As Object, objSubFolder As Object
  Dim Mes As String
  Set objFs = CreateObject("Scripting.FileSystemObject")
  For Each objFile In objFolder.Files
    If Left(objFile.Name, 4) = "××××" Then
      If objFs.FileExists(Path & objFile.Name) Then
        Mes = Path & objFile.Name & "はすでに存在します" & vbCr & "上書きしますか?"
        If MsgBox(Mes, vbYesNo) = vbYes Then
          Call objFs.Copyfile(objFolder.Path & "\××××*", Path)
        End If
      Else
        Call objFs.Copyfile(objFolder.Path & "\××××*", Path)
      End If
    End If
  Next
  For Each objSubFolder In objFolder.SubFolders
    Call MyFileCopy(objSubFolder, Path)
  Next
End Sub

1 hits

【5238】指定ディレクトリからファイルを探しコピー jam 03/4/30(水) 12:01 質問
【5241】「ある条件」って何? こう 03/4/30(水) 12:54 発言
【5245】Re:「ある条件」って何? jam 03/4/30(水) 13:36 回答
【5252】Re:「ある条件」って何? jam 03/4/30(水) 14:54 質問
【5256】Re:指定ディレクトリからファイルを探しコ... ポンタ 03/4/30(水) 16:04 回答
【5257】Re:指定ディレクトリからファイルを探しコ... jam 03/4/30(水) 16:20 質問
【5258】Re:指定ディレクトリからファイルを探しコ... ポンタ 03/4/30(水) 16:31 回答
【5260】Re:指定ディレクトリからファイルを探しコ... jam 03/4/30(水) 16:46 質問
【5262】Re:指定ディレクトリからファイルを探しコ... ポンタ 03/4/30(水) 17:58 回答
【5263】Re:指定ディレクトリからファイルを探しコ... jam 03/4/30(水) 19:15 お礼
【5259】別解 ichinose 03/4/30(水) 16:44 回答
【5264】Re:別解 jam 03/4/30(水) 19:18 お礼

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