to move files from one folder to another using VBA

Question

I have a code which can transfer the Excel files from one folder to another but i would like to update the code so that it can move all the files (.xml, .txt, .pdf, etc.) from one folder to another.

Sub MoveFiles()
    
    Dim sourceFolderPath As String, destinationFolderPath As String
    Dim FSO As Object, sourceFolder As Object, file As Object
    Dim fileName As String, sourceFilePath As String, destinationFilePath As String
    
    Application.ScreenUpdating = False
    
    sourceFolderPath = "E:\Source"
    destinationFolderPath = "E:\Destination"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set sourceFolder = FSO.GetFolder(sourceFolderPath)
    
    For Each file In sourceFolder.Files
    
        fileName = file.Name
    
        If InStr(fileName, ".xlsx") Then ' Only xlsx files will be moved
    
            sourceFilePath = file.Path
            destinationFilePath = destinationFolderPath & "\" & fileName
            FSO.MoveFile Source:=sourceFilePath, Destination:=destinationFilePath
    
        End If ' If InStr(sourceFileName, ".xlsx") Then' Only xlsx files will be moved
    
    Next
    
    'Don't need set file to nothing because it is initialized in for each loop
    'and after this loop is automatically set to Nothing    
    Set sourceFolder = Nothing    
    Set FSO = Nothing    
End Sub


can you please help

Answer 1

Move Files Using MoveFile

• You would get greater control of things by using CopyFile and DeleteFile instead of MoveFile.
• Using Dir, FileCopy, and Kill, instead of the FileSystemObject object and its methods, would make it simpler and also faster.

Option Explicit

Sub MoveFilesTEST()

    Const sFolderPath As String = "E:\Source"
    Const dFolderPath As String = "E:\Destination"
    Const FilePattern As String = "*.*"
    
    MoveFiles sFolderPath, dFolderPath, FilePattern

End Sub

Sub MoveFiles( _
        ByVal SourceFolderPath As String, _
        ByVal DestinationFolderPath As String, _
        Optional ByVal FilePattern As String = "*.*")
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(SourceFolderPath) Then
        MsgBox "The source folder path '" & SourceFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    If Not fso.FolderExists(DestinationFolderPath) Then
        MsgBox "The destination folder path '" & DestinationFolderPath _
            & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    Dim apSep As String: apSep = Application.PathSeparator
    
    Dim sPath As String: sPath = SourceFolderPath
    If Left(sPath, 1) <> apSep Then sPath = sPath & apSep
        
    Dim sFolder As Object: Set sFolder = fso.GetFolder(sPath)
    If sFolder.Files.Count = 0 Then
        MsgBox "There are no files in the source folder '" & sPath & "'.", _
            vbExclamation
        Exit Sub
    End If
    
    Dim dPath As String: dPath = DestinationFolderPath
    If Left(dPath, 1) <> apSep Then dPath = dPath & apSep
        
    Dim dFolder As Object: Set dFolder = fso.GetFolder(dPath)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sFile As Object
    Dim dFilePath As String
    Dim ErrNum As Long
    Dim MovedCount As Long
    Dim NotMovedCount As Long
    
    For Each sFile In sFolder.Files
        dFilePath = dPath & sFile.Name
        If fso.FileExists(dFilePath) Then
            dict(sFile.Path) = Empty
            NotMovedCount = NotMovedCount + 1
        Else
            On Error Resume Next
                fso.MoveFile sFile.Path, dFilePath
                ErrNum = Err.Number
                ' e.g. 'Run-time error '70': Permission denied' e.g.
                ' when the file is open in Excel
            On Error GoTo 0
            If ErrNum = 0 Then
                MovedCount = MovedCount + 1
            Else
                dict(sFile.Path) = Empty
                NotMovedCount = NotMovedCount + 1
            End If
        End If
    Next sFile
    
    Dim Msg As String
    Msg = "Files moved: " & MovedCount & "(" & NotMovedCount + MovedCount & ")"
    If NotMovedCount > 0 Then
        Msg = Msg & vbLf & "Files not moved:" & NotMovedCount & "(" _
            & NotMovedCount + MovedCount & ")" & vbLf & vbLf _
            & "The following files were not moved:" & vbLf _
            & Join(dict.keys, vbLf)
    End If
    
    MsgBox Msg, IIf(NotMovedCount = 0, vbInformation, vbCritical)
 
End Sub