Move only files with matching files names from one folder to another folder

Question

I want to copy only the files from one folder “the FromPath” that have the same file name (with different extensions) as in another folder the “the ToPath”. Only the shared file named files will be moved. I think the code would have to first look in the ToPath folder to get the names of the files and then cross reference those in the “FromPath” folder.

Thanks

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

You pretty much have it. I made a couple of small additions. First I make a unique list of local files in the colFiles collection. I did this because you are copying to a remote server. I think it will probably be quicker this way. Once you have the list of local files, you simply loop through the collection checking to see if they exist in the remote folder, and copy them if they do.

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