Option Explicit
Sub KillPreviousFile()
Dim szMsgResponse As String
Dim szDefaultName As String
szDefaultName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
StartAgain:
Dim szNewBookName As String
szNewBookName = InputBox("Please enter a name for the new file" & _
vbNewLine & _
"It will be saved in the same directory as the original" & vbNewLine & _
vbNewLine & _
"Valid file-names cannot include these characters" & vbNewLine & _
"< > \ / * ? | : ; """, , szDefaultName)
If szNewBookName <> Empty Then
Application.DisplayAlerts = False
Dim szOldBook As String
szOldBook = ThisWorkbook.FullName
Dim szThisPath As String
szThisPath = ThisWorkbook.Path & "\"
Dim szNewFileName As String
szNewFileName = szThisPath & szNewBookName & ".xls"
If szNewFileName = szOldBook Then
szMsgResponse = MsgBox("The new file name is the same as the original" & _
vbNewLine & "Would you like to save now, try again, or cancel?", 19)
Select Case szMsgResponse
Case 2
Exit Sub
Case 7
GoTo StartAgain
Case 6
ThisWorkbook.Save
Exit Sub
End Select
End If
On Error GoTo ExitProc
ThisWorkbook.SaveAs szNewFileName, xlWorkbookNormal
Kill szOldBook
Else
Exit Sub
End If
ExitProc:
Application.DisplayAlerts = True
Exit Sub
InvalidName:
MsgBox Err.Description
GoTo ExitProc
End Sub
|