Help with VBA to move and rename files

wrmcmahan12

New Member
Joined
May 13, 2015
Messages
12
Hello. I am looking to adjust a VBA code that is used to move files of a given name into the same folder. A simplified version of this would be 3 separate folders each containing a file named Cost.xlsx. The purpose of the macro is to check if the Cost.xlsx exists in a given path, and if it does, it moves it into a new folder as "source folder".xlsx (where source folder is the name of its origin). In the excel spreadsheet I have the source paths in column A and the destination paths and new names in column B. The macro works perfectly, however someone asked if it was possible to name the files differently so they can have more than one of the Cost.xlsx files open at once. The current input and output is below:

Source Path (cell A1)Destination Path (cell B1)
C:\Locations\Group 1\Cost.xlsxC:\Locations\Result\Cost\Group 1.xlsx
C:\Locations\Group 2\Cost.xlsxC:\Locations\Result\Cost\Group 2.xlsx
C:\Locations\Group 3\Cost.xlsxC:\Locations\Result\Cost\Group 3.xlsx

<tbody>
</tbody>

What I would like to do is be able to search for the file based on a wild card so that if Cost.xlsx is renamed to Cost1.xlsx, it will still recognize it as the correct file to move. I tried changing the source name as shown below, but the macro does not recognize the source files anymore:

Source PathDestination Path
C:\Locations\Group 1\Cost*.xlsxC:\Locations\Result\Cost\Group 1.xlsx
C:\Locations\Group 2\Cost*.xlsxC:\Locations\Result\Cost\Group 2.xlsx
C:\Locations\Group 3\Cost*.xlsxC:\Locations\Result\Cost\Group 3.xlsx

<tbody>
</tbody>

So my question is, what do I need to do in the macro or in the source path naming so that the macro will recognize a renamed version of Cost.xlsx (such as Cost - Copy.xlsx or Cost1.xlsx)? The VBA code I am using is below. Thanks again!

Sub MoveFiles()
Dim R As Range
Dim SourcePath As String, DestPath As String, FName As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")

For i = 2 To 4
'Setup source and dest path (Note: must have a trailing backslash!)
SourcePath = ActiveSheet.Range("a" & i)
DestPath = ActiveSheet.Range("b" & i)
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(SourcePath) Then
ActiveSheet.Cells(i, 3) = "File Not Found in Source Folder"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(DestPath) Then
FSO.CopyFile (SourcePath), DestPath, True
ActiveSheet.Cells(i, 3) = "Copied Successfully"
Else
ActiveSheet.Cells(i, 3) = "Already Exist"
End If
Next i
End Sub
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Watch MrExcel Video

Forum statistics

Threads
1,099,539
Messages
5,469,290
Members
406,647
Latest member
ssinovec

This Week's Hot Topics

Top