I have a code that copies workbook to a folder by cell value (A1) and month/year. It works fine but I need it to send a 2nd copy to another folder so I can have a back up. I would like to have the workbook copied to two separate folders with the same exact name (value in A1 and month/year). I would like to be able to check both folders to see if there are duplicate folders first and if so then overwrite. Can anyone please help. thank you
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Would you like to back up file?", vbYesNo) = vbYes Then _
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Sheets("SAP 1 PRINT ONLY").Range("A1").Value
'Change the date format to whatever you'd like, but make sure it's in quotes
newFile = fName & " " & Format$(Date, "mmmm-yyyy")
' Change directory to suit your PC, including USER NAME
ChDir _
"S:\Active Individual Programs\Manager folder\New Programs\"
ActiveWorkbook.SaveAs Filename:=newFile
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Would you like to back up file?", vbYesNo) = vbYes Then _
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Sheets("SAP 1 PRINT ONLY").Range("A1").Value
'Change the date format to whatever you'd like, but make sure it's in quotes
newFile = fName & " " & Format$(Date, "mmmm-yyyy")
' Change directory to suit your PC, including USER NAME
ChDir _
"S:\Active Individual Programs\Manager folder\New Programs\"
ActiveWorkbook.SaveAs Filename:=newFile
End If
End Sub