The following macro fails to move or copy files to the destination folder. It appears to successfully copy the selected files but
fails on moving. I would appreciate your testing of the entire code and provide a solution to moving the files. Thank you in advance.
Code:
Sub MoveUserSelectedFiles()
Dim sourceFiles As FileDialog
Dim destinationFolder As String
Dim filePath As String
Dim fso As Object
Dim i As Integer
' Initialize FileDialog for selecting files
Set sourceFiles = Application.FileDialog(msoFileDialogFilePicker)
sourceFiles.Title = "Select Files to Move"
sourceFiles.AllowMultiSelect = True
' Show file selection dialog
If sourceFiles.Show = -1 Then
If sourceFiles.SelectedItems.Count = 0 Then
MsgBox "No files were selected. Operation cancelled.", vbExclamation
Exit Sub
End If
' Initialize FileDialog for selecting the destination folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Destination Folder"
If .Show = -1 Then
destinationFolder = .SelectedItems(1) & "\"
Else
MsgBox "No destination folder selected. Operation cancelled.", vbExclamation
Exit Sub
End If
End With
Else
MsgBox "No files selected. Operation cancelled.", vbExclamation
Exit Sub
End If
' Initialize FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Loop through selected files and move them
For i = 1 To sourceFiles.SelectedItems.Count
filePath = sourceFiles.SelectedItems(i)
' Ensure the file exists before moving
If fso.FileExists(filePath) Then
Debug.Print "Moving: " & filePath & " to " & destinationFolder & fso.GetFileName(filePath)
' Try CopyFile first to verify access
On Error Resume Next
'fso.CopyFile filePath, destinationFolder & fso.GetFileName(filePath)
fso.MoveFile filePath, destinationFolder & fso.GetFileName(filePath)
If Err.Number <> 0 Then
MsgBox "Error moving file: " & filePath & vbNewLine & "Error: " & Err.Description, vbCritical
Err.Clear
Else
' Only delete after confirming successful copy
fso.DeleteFile filePath
End If
On Error GoTo 0
Else
MsgBox "File not found or inaccessible: " & filePath, vbCritical
End If
Next i
MsgBox "Files moved successfully!", vbInformation
' Clean up
Set fso = Nothing
Set sourceFiles = Nothing
End Sub