Macro to save daterev and time

baber62
baber62 used Ask the Experts™
on
I have a macro which needs a little tweaking. The macro currently saves file with date revision number and time. It's working fine. However, I now need to adapt this macro.

I have say two folders as follows:

(1) C:\Current file folder and
(2) C:\Superseded file folder


1. When file is opened from folder (1) to save in folder (2) with date/revision number/time stamp.

2. Then when closing or saving the file in folder (1) to overwrite or kill the existing file and save with date/revision/time stamp.

3. If, however, there have been no changes made to the file. Then just allow close without adding new date/revision/time stamp

I would be satisfied with a solution which would cover the first two points above and would add extra points if solution covered all three points.
SaveNumberedVersion.txt
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2012

Commented:
>>1. When file is opened from folder (1) to save in folder (2) with date/revision number/time stamp.

Please clarify this.

Dave

Author

Commented:
Okay so when file is opened from folder (1) need macro to save "copy" of file in folder (2) with the date/ revision/time stamp. Basically to keep a copy of the file in the superseded folder.

You have given me thought which could help ... just bear with me a minute ... ...

OK so when we do the save the first time file is saved in both folders (1) and (2) then when file is subsequently saved it is saved in folder (2) but in folder (1) it overwrites or kills the previous version. Hence in folder (1) we will always have the latest version of the file to hand.
Most Valuable Expert 2012
Top Expert 2012

Commented:
How do you plan to run this code, if the file has never been saved (e.g., it is being saved for the first time)?

Dave
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Most Valuable Expert 2012
Top Expert 2012

Commented:
>>1. When file is opened from folder (1) to save in folder (2) with date/revision number/time stamp.

2. Then when closing or saving the file in folder (1) to overwrite or kill the existing file and save with date/revision/time stamp.

Ok - if the folder is opened from Folder (1), then ensure it is saved in folder (2) and also the original file that was opened, gets deleted?  Correct?

Your statement #2 appears invalid, as one would never save a file in folder (1).  Did you mean Folder (2)??

3. If, however, there have been no changes made to the file. Then just allow close without adding new date/revision/time stamp

Easily done.

I'll code as I stated, above, unless you have objections.

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
Ok.  I believe I've completed all 3.

If the workbook needs to be saved, then
    if the file is opened in folder 1, then
        on save, it will be saved in folder 2 and deleted from folder 1

Be sure to set the curFolder and superceededFolder strings in the code, below, with their respective path/values.

Here's the code:
Sub SaveNumberedVersion()

    Dim strVer As String
    Dim strDate As String
    Dim strPath As String
    Dim strFile As String
    Dim strOldFilePath 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
    Dim curFolder As String
    Dim superceededFolder As String
    Dim bKillCurrent As Boolean
    
    curFolder = "C:\Current file folder"
    superceededFolder = "C:\Superseded file folder"
       
    'if file is opened from current folder, then ensure it is deleted when saving into superceeded folder
    If ActiveWorkbook.Path = curFolder Then
        bKillCurrent = True
        strOldFilePath = ActiveWorkbook.FullName
    End If
           
    'determine if the workbook needs to be saved
    If Not ActiveWorkbook.Saved Then
        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 = superceededFolder & "\" & 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
        If bKillCurrent Then Kill strOldFilePath
    End If
    Exit Sub

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

Open in new window


See attached.

Dave
saveNumberedVersion-r1.xls

Author

Commented:
Ok Dave When I run the macro it runs for the first time but deletes the file from the current directory so file is in superseded folder only.

The "current" directory should have the latest version of the file. The "superseded" should have all the previous version of the file.
Most Valuable Expert 2012
Top Expert 2012

Commented:
You know, English is such a poor language.
Most Valuable Expert 2012
Top Expert 2012
Commented:
Ok.  I think I understand.

the file is opened in current folder.  if it needs to be saved, then save a copy of the new version in the superceeded folder, then save in the current folder, and delete the old version from the current folder.

As a result, each save with changes will have a backup in the superceeded folder, but only the latest file will be in the current folder.

Here's the code:

Sub SaveNumberedVersion()

    Dim strVer As String
    Dim strDate As String
    Dim strPath As String
    Dim strFile As String
    Dim strOldFilePath 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
    Dim curFolder As String
    Dim superceededFolder As String
    
    curFolder = "C:\Current file folder"
    superceededFolder = "C:\Superseded file folder"
    
    'Assume file is opened from current folder, then make a backup to superceeded folder, delete old version and save new version in current folder

    strOldFilePath = ActiveWorkbook.FullName
           
    'determine if the workbook needs to be saved
    If Not ActiveWorkbook.Saved Then
        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 = "\" & strFile & " - " & strDate & " - Rev " & Format(Val(strVer), "00# ") & Format(Time(), "hh-mm") & Chr(46) & sExt
        
        'first make a backup of the file
        ActiveWorkbook.SaveCopyAs Filename:=superceededFolder & strVersionName
        
        'and save a copy of the file with that name
        ActiveWorkbook.SaveAs Filename:=curFolder & strVersionName
        Kill strOldFilePath
    End If
    Exit Sub

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

Open in new window


See attached.  I now believe all 3 items you requested are correct.

Dave
saveNumberedVersion-r2.xls

Author

Commented:
Ok I have opened the workbook attached. The macro goes through the procedure without any problem. However, when I click on it again it does not run. I have even open the coding for the macro and run through it using the F8 key first time works like a charm second time it jumps from the following line

If Not ActiveWorkbook.Saved Then

to

exit sub

without executing the coding in between. Can't see why this is happening.
Most Valuable Expert 2012
Top Expert 2012

Commented:
It doesn't run, because the workbook does not need to be saved.  That was your request #3, correct?

To "test" type a character or something in a cell so the workbook IS changed, then you'll see what happens ;)

Dave

Author

Commented:
Excellent turnaround time. Much appreciated.
Most Valuable Expert 2012
Top Expert 2012

Commented:
You're welcome.

Did I get all three points? (re: your original question)

Dave

Author

Commented:
Yes you got all three points I requested.

1. File saves in current folder saving latest version of file
2. Backup of file saved in superseded folder
3. If File isn't changed it won't be saved with new revision number, it will just be closed.

Once again I have to bow to your excel / vba skills :)))

Baber

Commented:
dlmille

Thank you very much for this nifty bit of work!

Graham

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial