asked on

VBA Script for moving multiple files based on an excel list

I have a list of documents in an excel file and want to use this list to move specific PDF files from one folder to another. Is there a script that can be produced in Excel VBA to assist in this task. Also, can the script be made so it can be used for any type of document transfer?

An example of the script requirements would be

A POP-up box would appear requesting the list range
A POP-up box would appear requesting the location of files to be transferred
A POP-up box would appear requesting destination of the files to be moved

Subodh Tiwari (Neeraj)

You may give this a try...
The code assumes that the file names in the range are mentioned as file name only along with the file extension like File1.pdf etc.
You may have the different files in the range and the code will move them to the selected destination folder.

Sub MoveFiles()
Dim rngFiles As Range, aCell As Range
Dim SourceFolder As String, DestinationFolder As String
Dim fso As Scripting.FileSystemObject
Dim file As file

On Error Resume Next
'You are supposed to select the range with the file names
'Assuming file names are listed along with the file extension and without the path...
'like File1.pdf or Book1.xlsx or Test1.txt etc
Set rngFiles = Application.InputBox("Please select the range with file names.", "Select Range!", Type:=8)
On Error GoTo 0

If rngFiles Is Nothing Then
    MsgBox "You didn't select any range.", vbExclamation
    Exit Sub
End If

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Source Folder!"
    .AllowMultiSelect = False
    If .Show = -1 Then
        SourceFolder = .SelectedItems(1)
    Else
        MsgBox "You didn't select the Source Folder.", vbExclamation
        Exit Sub
    End If
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Destination Folder!"
    .AllowMultiSelect = False
    If .Show = -1 Then
        DestinationFolder = .SelectedItems(1)
    Else
        MsgBox "You didn't select the Destination Folder.", vbExclamation
        Exit Sub
    End If
End With

Set fso = New Scripting.FileSystemObject

For Each aCell In rngFiles
    If aCell <> "" Then
        If fso.FileExists(SourceFolder & "\" & aCell.Value) Then
            Set file = fso.GetFile(SourceFolder & "\" & aCell.Value)
            If fso.FileExists(DestinationFolder & "\" & aCell.Value) Then fso.GetFile(DestinationFolder & "\" & aCell.Value).Delete
            file.Move DestinationFolder & "\"
        End If
    End If
Next aCell
Set fso = Nothing
End Sub

Open in new window

Stuart Smith

ASKER

When I went to run the code an error appeared. I have attached the spreadsheet so you may review and advise.

Thanks in advance

Stuart
Move-Files.xlsm

Subodh Tiwari (Neeraj)

What error?
BTW what range did you select? As per the existing code, you are supposed to...
1) Select the range in column A with file names.
2) Select the Source Folder where these files may exist.
3) Select the Destination Folder.

Then the code will check each file listed in column A in the selected Source Folder and if the file exists there, it will be moved to the Destination Folder.

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Stuart Smith

ASKER

Thank you so much, this will save me a lot of work.

Subodh Tiwari (Neeraj)

You're welcome!