Opv
02-22-2013, 05:09 PM
I have a VBA script that has worked flawlessly until I added some code to the ThisWorkbook module. I added the following snippet:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'UPDATE FILE NAME
Dim nameRng As Range, nameVar, verVar As Variant
Dim oldVersion, newVersion, oldPath, oldName, newName As String
oldPath = ThisWorkbook.Path
oldName = ThisWorkbook.Name
Set nameRng = Sheets("RENT").Range("C3")
'Extract current version from worksheet
nameVar = Split(oldName, " ")
verVar = Split(nameRng, " ")
oldVersion = nameVar(UBound(nameVar))
newVersion = verVar(0)
'Create New Filename
newName = Mid(oldName, 1, 22)
newName = newName & " " & newVersion & ".xls"
'Save workbook with new name
Application.DisplayAlerts = False
If newVersion & ".xls" = oldVersion Then
GoTo closeIt
Else
On Error Resume Next
ThisWorkbook.SaveAs newName
Kill "" & oldPath & "\" & oldName & ""
On Error GoTo 0
End If
closeIt:
Application.DisplayAlerts = True
End Sub
The objective is to automatically save the workbook under a new name (using SAVEAS), with the old version stripped from the name and the new filename reflecting the new version number for the workbook. The next step is to delete (KILL) the old file.
The above code works at times but other times causes Excel to crash. It crashes about as as often (or more often) than it works without crashing. Does anything jump out as what might be the culprit?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'UPDATE FILE NAME
Dim nameRng As Range, nameVar, verVar As Variant
Dim oldVersion, newVersion, oldPath, oldName, newName As String
oldPath = ThisWorkbook.Path
oldName = ThisWorkbook.Name
Set nameRng = Sheets("RENT").Range("C3")
'Extract current version from worksheet
nameVar = Split(oldName, " ")
verVar = Split(nameRng, " ")
oldVersion = nameVar(UBound(nameVar))
newVersion = verVar(0)
'Create New Filename
newName = Mid(oldName, 1, 22)
newName = newName & " " & newVersion & ".xls"
'Save workbook with new name
Application.DisplayAlerts = False
If newVersion & ".xls" = oldVersion Then
GoTo closeIt
Else
On Error Resume Next
ThisWorkbook.SaveAs newName
Kill "" & oldPath & "\" & oldName & ""
On Error GoTo 0
End If
closeIt:
Application.DisplayAlerts = True
End Sub
The objective is to automatically save the workbook under a new name (using SAVEAS), with the old version stripped from the name and the new filename reflecting the new version number for the workbook. The next step is to delete (KILL) the old file.
The above code works at times but other times causes Excel to crash. It crashes about as as often (or more often) than it works without crashing. Does anything jump out as what might be the culprit?