It's been a while so please forgive me for sounding dumb
Anyway, this macro used to work fine, now it gives me a Runtime Error 75
>it may be related to permissions. Something to do with Personal.xlsb or workbook
I have a button on my excel toolbar that calls the macro that resides in Personal.xlsb (I think. like I said its been a while)
Macro deconstructs the existing filename, adds "backup dated <date>" to the base filename
Then saves the new file to an existing folder called "backups".
Then reopens the original file
Please don't suggest other ways of doing this. Like I said, it used to work fine.
And like I said, I don't think the problem is with the macro, my gut sez its a permission thing with personable.xlsb or workbooks.
Thank you
Sub MakeDatedBackup()
'Dim t As Date
Dim OldPathFileExt As Variant
Dim OldPathFile As String
Dim OldPath As Variant
Dim OldFilename As String
Dim RootFilename As String
Dim Ext As String
Dim NewFilename As Variant
Dim NewPath As String
Dim OldFile As String
Dim NewPathFileExt As String
Dim answer As Long
Dim strDate As String
'Date
strDate = Format(Now, "mm-dd-yy")
'Filename
'Deconstruct old file, construct new file
OldPathFileExt = ActiveWorkbook.FullName
OldPath = ActiveWorkbook.Path
OldFilename = ActiveWorkbook.Name
filename = Left(OldFilename, InStr(OldFilename, ".") - 1)
Ext = "." & Right(OldFilename, Len(OldFilename) - InStrRev(OldFilename, "."))
NewFilename = filename & " " & strDate & Ext
NewPath = OldPath & "/Backups/"
NewPathFileExt = NewPath & NewFilename
'XX Check if backup already exists
'Deleted Already Exists check
'Write NewFilename to /Backups folder even if it already exists.
'Filethere = (Dir(NewPathFileExt) > "")
' If Filethere = False Then
' GoTo Backup
' Else'
' Ask to Overwrite
' answer = MsgBox("Backup file exists, Overwrite? ", vbOKCancel)
' If answer = vbOK Then
'Backup:
'If file DOESN'T exist, write file to /Backups
'If file DOES exist, overwrite it anyway
'Close because FileCopy doesn't work on open files
ActiveWorkbook.Close
'Copy original to :Backups w/new Filename
'>> Runtime error 75
'>> Path/File access error
'>> next line yellow when I debug
'>> OldPathFileExt and NewPathFileExt look good
FileCopy OldPathFileExt, NewPathFileExt
'Open Original Workbook
Workbooks.Open filename:=(OldPathFileExt)
With ActiveWindow
.WindowState = xlMaximized
End With
MsgBox _
"Backup Complete" & vbCrLf & _
NewFilename & vbCrLf & _
"Saved To: " & NewPath
End Sub
Anyway, this macro used to work fine, now it gives me a Runtime Error 75
>it may be related to permissions. Something to do with Personal.xlsb or workbook
I have a button on my excel toolbar that calls the macro that resides in Personal.xlsb (I think. like I said its been a while)
Macro deconstructs the existing filename, adds "backup dated <date>" to the base filename
Then saves the new file to an existing folder called "backups".
Then reopens the original file
Please don't suggest other ways of doing this. Like I said, it used to work fine.
And like I said, I don't think the problem is with the macro, my gut sez its a permission thing with personable.xlsb or workbooks.
Thank you
Sub MakeDatedBackup()
'Dim t As Date
Dim OldPathFileExt As Variant
Dim OldPathFile As String
Dim OldPath As Variant
Dim OldFilename As String
Dim RootFilename As String
Dim Ext As String
Dim NewFilename As Variant
Dim NewPath As String
Dim OldFile As String
Dim NewPathFileExt As String
Dim answer As Long
Dim strDate As String
'Date
strDate = Format(Now, "mm-dd-yy")
'Filename
'Deconstruct old file, construct new file
OldPathFileExt = ActiveWorkbook.FullName
OldPath = ActiveWorkbook.Path
OldFilename = ActiveWorkbook.Name
filename = Left(OldFilename, InStr(OldFilename, ".") - 1)
Ext = "." & Right(OldFilename, Len(OldFilename) - InStrRev(OldFilename, "."))
NewFilename = filename & " " & strDate & Ext
NewPath = OldPath & "/Backups/"
NewPathFileExt = NewPath & NewFilename
'XX Check if backup already exists
'Deleted Already Exists check
'Write NewFilename to /Backups folder even if it already exists.
'Filethere = (Dir(NewPathFileExt) > "")
' If Filethere = False Then
' GoTo Backup
' Else'
' Ask to Overwrite
' answer = MsgBox("Backup file exists, Overwrite? ", vbOKCancel)
' If answer = vbOK Then
'Backup:
'If file DOESN'T exist, write file to /Backups
'If file DOES exist, overwrite it anyway
'Close because FileCopy doesn't work on open files
ActiveWorkbook.Close
'Copy original to :Backups w/new Filename
'>> Runtime error 75
'>> Path/File access error
'>> next line yellow when I debug
'>> OldPathFileExt and NewPathFileExt look good
FileCopy OldPathFileExt, NewPathFileExt
'Open Original Workbook
Workbooks.Open filename:=(OldPathFileExt)
With ActiveWindow
.WindowState = xlMaximized
End With
MsgBox _
"Backup Complete" & vbCrLf & _
NewFilename & vbCrLf & _
"Saved To: " & NewPath
End Sub