How to move files using partial file name?

Question

I learnt how to copy multiple files from a single folder to multiple folders depending on file name in Excel sheet.

Sub MoveSelectedfiles()

    Dim FSO As Scripting.FileSystemObject
    Dim fl As Scripting.File
    Dim sourcefldr As Scripting.Folder
    Dim destinationFldr As Scripting.Folder
    Dim index As Integer
    Dim lastrow As Integer
    
    Set FSO = New FileSystemObject
    Set sourcefldr = FSO.GetFolder("E:\Testing\Source")
    Set destinationFldr = FSO.GetFolder("E:\Testing\Destination")
    
    lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
                
    For index = 2 To 10
    
        If (FSO.FileExists(sourcefldr.Path & "\" & Sheet1.Range("A" & index).Value)) Then
            FSO.MoveFile sourcefldr.Path & "\" & Sheet1.Range("A" & index).Value, destinationFldr.Path & "\"
        End If
     
    Next index
     
End Sub

I have to define the exact file name. I would like to write even half/incomplete file name.

E.g. If a file name is "Excel training makes easy" and in the Excel sheet I write "Excel training".

user_9814069 · Answer

Move Files From a List of Partial File Names

You can use the Dir function with wild characters (* and ?) to test if a file exists, e.g.:

Begins with

sFileName = Dir(sFolderPath & sPartialFileName & "*")

Contains

sFileName = Dir(sFolderPath & "*" & sPartialFileName & "*")

Then you can continue with:

if len(sFileName) > 0 Then ' source file found

Partial File Names

Sub MoveFilesFromListPartial()
    
    Const sPath As String = "E:\Testing\Source"
    Const dPath As String = "E:\Testing\Destination"
    Const fRow As Long = 2
    Const Col As String = "A"
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = Sheet1
    
    ' Calculate the last row,
    ' i.e. the row containing the last non-empty cell in the column.
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
                
    ' Validate the last row.
    If lRow < fRow Then
        MsgBox "No data in column range.", vbCritical
        Exit Sub
    End If
    
    ' Early Binding - needs a reference
    ' to 'Tools > References > Microsoft Scripting Runtime' (has intelli-sense)
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    ' Late Binding - needs no reference (no intelli-sense)
    'Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Validate the source folder path.
    Dim sFolderPath As String: sFolderPath = sPath
    If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    If Not fso.FolderExists(sFolderPath) Then
        MsgBox "The source folder path '" & sFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    ' Validate the destination folder path.
    Dim dFolderPath As String: dFolderPath = dPath
    If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
    If Not fso.FolderExists(dFolderPath) Then
        MsgBox "The destination folder path '" & dFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    Dim r As Long ' current row in worksheet column
    Dim sFilePath As String
    Dim sPartialFileName As String
    Dim sFileName As String
    Dim dFilePath As String
    Dim sYesCount As Long ' source file moved
    Dim sNoCount As Long ' source file not found
    Dim dYesCount As Long ' source file exists in destination folder
    Dim BlanksCount As Long ' blank cell
    
    For r = fRow To lRow
        sPartialFileName = CStr(ws.Cells(r, Col).Value)
        If Len(sPartialFileName) > 0 Then ' the cell is not blank
            ' 'Begins with' sPartialFileName
            sFileName = Dir(sFolderPath & sPartialFileName & "*")
            ' or instead, 'Contains' sPartialFileName
            'sFileName = Dir(sFolderPath & "*" & sPartialFileName & "*")
            If Len(sFileName) > 0 Then ' source file found
                sFilePath = sFolderPath & sFileName
                dFilePath = dFolderPath & sFileName
                If Not fso.FileExists(dFilePath) Then ' the source file...
                    fso.MoveFile sFilePath, dFilePath ' ... doesn't exist...
                    sYesCount = sYesCount + 1 ' ... in the destination
                Else ' the source file exists in the destination folder
                    dYesCount = dYesCount + 1
                End If
            Else ' the source file doesn't exist
                sNoCount = sNoCount + 1
            End If
        Else ' the cell is blank
            BlanksCount = BlanksCount + 1
        End If
    Next r
 
    MsgBox "Stats" & vbLf _
        & "Source files moved: " & sYesCount & vbLf _
        & "Source files not found: " & sNoCount & vbLf _
        & "Source files existed in destination: " & dYesCount & vbLf _
        & "Number of blank cells: " & BlanksCount & vbLf _
        & "Number of cells processed: " & lRow - fRow + 1, _
        vbInformation
 
End Sub

Full File Names

Sub MoveFilesFromList()
    
    Const sPath As String = "E:\Testing\Source"
    Const dPath As String = "E:\Testing\Destination"
    Const fRow As Long = 2
    Const Col As String = "A"
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = Sheet1
    
    ' Calculate the last row,
    ' i.e. the row containing the last non-empty cell in the column.
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
                
    ' Validate the last row.
    If lRow < fRow Then
        MsgBox "No data in column range.", vbCritical
        Exit Sub
    End If
    
    ' Early Binding - needs a reference
    ' to 'Tools > References > Microsoft Scripting Runtime' (has intelli-sense)
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    ' Late Binding - needs no reference (no intelli-sense)
    'Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Validate the source folder path.
    Dim sFolderPath As String: sFolderPath = sPath
    If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    If Not fso.FolderExists(sFolderPath) Then
        MsgBox "The source folder path '" & sFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    ' Validate the destination folder path.
    Dim dFolderPath As String: dFolderPath = dPath
    If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
    If Not fso.FolderExists(dFolderPath) Then
        MsgBox "The destination folder path '" & dFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    Dim r As Long ' current row in worksheet column
    Dim sFilePath As String
    Dim sFileName As String
    Dim dFilePath As String
    Dim sYesCount As Long ' source file moved
    Dim sNoCount As Long ' source file doesn't exist
    Dim dYesCount As Long ' source file exists in destination folder
    Dim BlanksCount As Long ' blank cell
    
    For r = fRow To lRow
        sFileName = CStr(ws.Cells(r, Col).Value)
        If Len(sFileName) > 0 Then ' the cell is not blank
            sFilePath = sFolderPath & sFileName
            If fso.FileExists(sFilePath) Then ' the source file exists
                dFilePath = dFolderPath & sFileName
                If Not fso.FileExists(dFilePath) Then ' the source file...
                    fso.MoveFile sFilePath, dFilePath ' ... doesn't exist...
                    sYesCount = sYesCount + 1 ' ... in the destination folder
                Else ' the source file exists in the destination folder
                    dYesCount = dYesCount + 1
                End If
            Else ' the source file doesn't exist
                sNoCount = sNoCount + 1
            End If
        Else ' the cell is blank
            BlanksCount = BlanksCount + 1
        End If
    Next r
 
    MsgBox "Stats" & vbLf _
        & "Source files moved: " & sYesCount & vbLf _
        & "Source files don't exist: " & sNoCount & vbLf _
        & "Source files existed in destination: " & dYesCount & vbLf _
        & "Number of blank cells: " & BlanksCount & vbLf _
        & "Number of cells processed: " & lRow - fRow + 1, _
        vbInformation
 
End Sub

How to move files using partial file name?

1 Answers

Move Files From a List of Partial File Names