to move files from one folder to another using VBA - excel

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