Add Today's Date to Copied File

[RichJW]

Hi all,

I have the below macro, which takes a copy of a file and places it in another location.

I’d like to edit the macro to add the date the report is run to the end of the filename saved in the destination folder. So, the name would become “Dashboard Workbook 0.31 2020-06-11.xlsm”, but “Dashboard Workbook 0.31 2020-06-18.xlsm” when I run it next week.

Sub CopyFile()

'Declare Variables

Dim FSO

Dim sFile As String

Dim sSFolder As String

Dim sDFolder As String


'File Name

sFile = "Dashboard Workbook 0.31.xlsm"


'Source

sSFolder = "C:\MyFolder\OneDrive\MI\"


'Destination

sDFolder = " C:\MyFolder\OneDrive\MI\Reports"


'Create Object

Set FSO = CreateObject("Scripting.FileSystemObject")


'Check If File Is Located in the Source Folder

If Not FSO.FileExists(sSFolder & sFile) Then

MsgBox "Specified File Not Found", vbInformation, "Not Found"


'Copy If the Same File is Not Located in the Destination Folder

ElseIf Not FSO.FileExists(sDFolder & sFile) Then

FSO.CopyFile (sSFolder & sFile), sDFolder, True

MsgBox "Specified File Copied Successfully", vbInformation, "Done"

Else

MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"

End If


End Sub


Any help appreciated.

Rich

 

[Logit]

.
See if this does the job. Untested here but I do believe it is correct ...

Dim FSO

Dim sFile As String

Dim sSFolder As String

Dim sDFolder As String

Dim dValue As String '<--- added

dValue = Format(Date, "yyyy-mm-dd") '<--- added

'File Name

sFile = "Dashboard Workbook 0.31 " & dValue & ".xlsm" '<--- added

'Source

sSFolder = "C:\MyFolder\OneDrive\MI\"

 

[RichJW]

Many thanks @Logit

I've added those bits in, however Excel tells me "Specified file not found".
It now shows this, hope I copied it as you suggested!
I'm not sure how it cannot find it, because it's there. in fact, the filename below is the one containing this macro, so it needs to find and copy itself.

Sub CopyFile()

'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim dValue As String

dValue = Format(Date, "yyyy-mm-dd")

'This is Your File Name which you want to Copy
sFile = "Dashboard Workbook 0.31.xlsm" & dValue & ".xlsm"

'Change to match the source folder path
sSFolder = "C:\MyFolder\OneDrive\MI\"

'Change to match the destination folder path
sDFolder = "C:\MyFolder\OneDrive\MI\Reports"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found", vbInformation, "Not Found"

'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If

End Sub

Thanks again,
Rich

 

[Logit]

.
I see the following as an issue :
'This is Your File Name which you want to Copy
sFile = "Dashboard Workbook 0.31.xlsm" & dValue & ".xlsm"
.
.
This part : "Dashboard Workbook 0.31.xlsm" ... should be ... "Dashboard Workbook 0.31 "
.
.
Note the space located at the end

 

[RichJW]

Thanks again Logit, but sadly not the issue.

I have tried it with and without the space, and with and without the ".xlsm" at the end of the filename, however it still cannot find the file.
I have just tested my previous macro, in my first post, and it still finds and copies the file - obviously without the date!

Cheers

 

[Logit]

If you can post your workbook for download (DropBox.com or similar) that would help.

 

[RichJW]

Wish I could, but I'd need to edit too much data, as it's regarding our customers.

 

[Logit]

Hold on. I working on a different approach that should work for you. Thanks.

 

[Logit]

.
Ok ... replace what you've been working with ... with the following. I hope the paths I've provided are accurate.
If you find it necessary to edit the paths ... do not delete the ENVIRON("UserProfile")

Option Explicit
'''
'strPathSource: The full path of the file to copy
'strPathOutput: The full to copy the file to
Private Sub Copy_File(ByVal strPathSource As String, ByVal strPathOutput As String)
Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

'copy file
Call objFSO.CopyFile(strPathSource, strPathOutput)

End Sub

Sub Example1()

Call Copy_File(Environ("UserProfile") & "\MyFolder\OneDrive\MI\Dashboard Workbook 0.31.xlsm", _
    Environ("UserProfile") & "\MyFolder\OneDrive\MI\Reports\Dashboard Workbook 0.31.xlsm")
   
    Application.DisplayAlerts = False
   
    Name Environ("UserProfile") & "\MyFolder\OneDrive\MI\Reports\Dashboard Workbook 0.31.xlsm" As Environ("UserProfile") & "\MyFolder\OneDrive\MI\Reports\Dashboard Workbook 0.31 " & Format(Date, "yyyy-mm-dd") & " .xlsm"
   
    Application.DisplayAlerts = True
   
End Sub

 

[RichJW]

Sorry for the delay @Logit

That's cracked it - thanks so much for your help.

Cheers,
Rich