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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

Forum statistics

Threads
1,214,629
Messages
6,120,630
Members
448,973
Latest member
ChristineC

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top