We help IT Professionals succeed at work.

Save file with new name and delete previous version excel

baber62
baber62 used Ask the Experts™
on
I have a macro (see below) which renames the file and saves file with revision version, date and time. However, using this macro I would also like to delete the previous version of the file. I would appreciate any help in achieving this.

Sub SaveNumberedVersion()

    Dim strVer As String
    Dim strDate As String
    Dim strPath As String
    Dim strFile As String
    Dim oVars As Variant
    Dim strFileType As Integer
    Dim strVersionName As String
    Dim intPos As Long
    Dim sExt As String
    Dim wb As Workbook
   
       
    Set oVars = ActiveWorkbook.CustomDocumentProperties
   
    strDate = Format((Date), "dd MMM yyyy")
   
       
    With ActiveWorkbook
        On Error GoTo CancelledByUser
        If Len(.Path) = 0 Then 'No path means document not saved
            .Save 'So save it
        End If
        strPath = .Path 'Get path
        strFile = .Name 'Get document name
    End With
    intPos = InStr(strFile, " - ") 'Mark the version number
    sExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".xl"))
    If intPos = 0 Then 'No version number
        intPos = InStrRev(strFile, ".xl") 'Mark the extension instead
    End If
    strFile = Left(strFile, intPos - 1) 'Strip the extension or version number
    Select Case LCase(sExt) 'Determine file type by extension
        Case Is = "xlsx"
            strFileType = 51
        Case Is = "xlsm"
            strFileType = 52
        Case Is = "xlsb"
            strFileType = 50
        Case Is = "xls"
            strFileType = 56
        'Case Is = "dotx"
            'strFileType = 14
        'Case Is = "dotm"
            'strFileType = 15
    End Select
Start: 'Get Registry Data
    On Error Resume Next 'No entry in registry will flag an error
    strVer = oVars("varVersion").Value
    On Error GoTo 0
    If strVer = "" Then 'Variable does not exist
        strVer = "0"
        ActiveWorkbook.CustomDocumentProperties.Add Name:="varVersion", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="0"
    End If
    strVer = Val(strVer) + 1 'Increment number
    oVars("varVersion").Value = strVer
    'Define the new version filename change version in line below to Rev if required
    strVersionName = strPath & "\" & strFile & " - " & strDate & _
    " - Rev " & Format(Val(strVer), "00# ") _
    & Format(Time(), "hh-mm") & Chr(46) & sExt
   
    'and save a copy of the file with that name
    ActiveWorkbook.SaveAs strVersionName
    Exit Sub

CancelledByUser: 'Error handler
    MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
Commented:
You want the Kill statement after you have saved the file. That can delete the original file.  See the three additional statement in your sub below.

Sub SaveNumberedVersion()

    Dim strVer As String
    Dim strDate As String
    Dim strPath As String
    Dim strFile As String
    Dim strOldFilePath As String                    '****Brad added this statement
    Dim oVars As Variant
    Dim strFileType As Integer
    Dim strVersionName As String
    Dim intPos As Long
    Dim sExt As String
    Dim wb As Workbook
   
       
    Set oVars = ActiveWorkbook.CustomDocumentProperties
    strOldFilePath = ActiveWorkbook.FullName        '****Brad added this statement
   
    strDate = Format((Date), "dd MMM yyyy")
   
       
    With ActiveWorkbook
        On Error GoTo CancelledByUser
        If Len(.Path) = 0 Then 'No path means document not saved
            .Save 'So save it
        End If
        strPath = .Path 'Get path
        strFile = .Name 'Get document name
    End With
    intPos = InStr(strFile, " - ") 'Mark the version number
    sExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".xl"))
    If intPos = 0 Then 'No version number
        intPos = InStrRev(strFile, ".xl") 'Mark the extension instead
    End If
    strFile = Left(strFile, intPos - 1) 'Strip the extension or version number
    Select Case LCase(sExt) 'Determine file type by extension
        Case Is = "xlsx"
            strFileType = 51
        Case Is = "xlsm"
            strFileType = 52
        Case Is = "xlsb"
            strFileType = 50
        Case Is = "xls"
            strFileType = 56
        'Case Is = "dotx"
            'strFileType = 14
        'Case Is = "dotm"
            'strFileType = 15
    End Select
Start: 'Get Registry Data
    On Error Resume Next 'No entry in registry will flag an error
    strVer = oVars("varVersion").Value
    On Error GoTo 0
    If strVer = "" Then 'Variable does not exist
        strVer = "0"
        ActiveWorkbook.CustomDocumentProperties.Add Name:="varVersion", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="0"
    End If
    strVer = Val(strVer) + 1 'Increment number
    oVars("varVersion").Value = strVer
    'Define the new version filename change version in line below to Rev if required
    strVersionName = strPath & "\" & strFile & " - " & strDate & _
    " - Rev " & Format(Val(strVer), "00# ") _
    & Format(Time(), "hh-mm") & Chr(46) & sExt
   
    'and save a copy of the file with that name, then delete the original
    ActiveWorkbook.SaveAs strVersionName
    Kill strOldFilePath                             '****Brad added this statement
    Exit Sub

CancelledByUser: 'Error handler
    MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub

Open in new window

Author

Commented:
Thanks Brad ... works like a charm