ファイル名が一致するファイルのみを1つのフォルダから別のフォルダに移動

Question

別のフォルダと同じファイル名（拡張子を持つ）を持つ1つのフォルダ "FromPath"からファイルをコピーしたい "ToPath" 。 filesという名前の共有ファイルだけが移動されます。ファイルの名前を取得してから "FromPath"フォルダにあるものを参照するためには、ToPathフォルダを最初に調べる必要があります。

おかげ

Private Sub CmdBtn_transfer_Click() 

Dim FSO As Object 
Dim FromPath As String 
Dim ToPath As String 
Dim FileExt As String 
Dim Val As String 
Dim i As Integer 

FromPath = "C:\Users\rossi\Desktop\Production files\" & (Me.ListBox1) '<< Change 

For i = 0 To ListBox2.ListCount - 1 
If ListBox2.Selected(i) = True Then 
    Val = ListBox2.List(i) 
End If 
Next i 
FileExt = "*.sli*" '<< Change 

If Right(FromPath, 1) <> "\" Then 
    FromPath = FromPath & "\" 
End If 

Set FSO = CreateObject("scripting.filesystemobject") 

If FSO.FolderExists(FromPath) = False Then 
    MsgBox FromPath & " doesn't exist" 
    Exit Sub 
End If 

For i = 0 To ListBox2.ListCount - 1 
    If ListBox2.Selected(i) Then 
     ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i)) '<< Change 

     If Right(ToPath, 1) <> "\" Then 
      ToPath = ToPath & "\" 
     End If 

     If FSO.FolderExists(ToPath) = False Then 
      MsgBox ToPath & " doesn't exist" 
      Exit Sub 
     End If 

     FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath 
     MsgBox "You can find the files from " & FromPath & " in " & ToPath 
    End If 
Next i 

End Sub 

Answer 1

あなたはかなりそれを持っています。私はいくつかの小さな追加をしました。まず、colFilesコレクションにローカルファイルの一意のリストを作成します。あなたがリモートサーバーにコピーしているので、私はこれを行いました。私はそれがおそらくこのように速くなると思う。ローカルファイルのリストを取得したら、コレクションのチェックをループしてリモートフォルダに存在するかどうかを確認し、リモートフォルダにコピーされている場合はコピーします。

Private Sub CmdBtn_transfer_Click() 

Dim FSO As Object 
Dim FromPath As String 
Dim ToPath As String 
Dim FileExt As String 
Dim Val As String 
Dim i As Integer 
Dim x As Integer 
Dim colFiles As New Collection 
Dim strFilename As String 

FromPath = "C:\Users\rossi\Desktop\Production files\" & (Me.ListBox1) '<< Change 

For i = 0 To ListBox2.ListCount - 1 
If ListBox2.Selected(i) = True Then 
    Val = ListBox2.List(i) 
End If 
Next i 
FileExt = "*.sli*" '<< Change 

If Right(FromPath, 1) <> "\" Then 
    FromPath = FromPath & "\" 
End If 

If FSO.FolderExists(FromPath) = False Then 
    MsgBox FromPath & " doesn't exist" 
    Exit Sub 
End If 

'Create a list of local filenames 
strFilename = Dir(FromPath & "*" & FileExt) 'Corrected 
While strFilename <> "" 
    colFiles.Add Left(strFilename, _ 
       InStr(1, strFilename, ".", vbBinaryCompare) - 1), _ 
       Left(strFilename, InStr(1, strFilename, ".", vbBinaryCompare) - 1) 
    strFilename = Dir() 
Wend 

Set FSO = CreateObject("scripting.filesystemobject") 

For i = 0 To ListBox2.ListCount - 1 
    If ListBox2.Selected(i) Then 
     ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i)) '<< Change 

     If Right(ToPath, 1) <> "\" Then 
      ToPath = ToPath & "\" 
     End If 

     If FSO.FolderExists(ToPath) = False Then 
      MsgBox ToPath & " doesn't exist" 
      Exit Sub 
     End If 

     'Now loop through our list of files to see if they exist on the remote server 
     For x = 1 To colFiles.Count 'Corrected 
      If FSO.FileExists(ToPath & colFiles.item(x) & FileExt) Then 
       FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath 
      End If 
     Next 

     MsgBox "You can find the files from " & FromPath & " in " & ToPath 
    End If 
Next i 

End Sub