Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!
Word macro to save file with date rev and timestamp
I have a macro which I use in word to save the file with date rev and timestamp added to the filename.
I need the macro to create a directory called superseded if one does not already exist and then to save the file in main directory and superseded directory. Then to "kill" the previous file from the main directory, and leave the current file in the directory.
BTW I have an excel macro which does this.
The macro for word is posted below:
Sub SaveNumberedVersion()
'Graham Mayor 15 Jan 2006
'Completely Revised 18 January 2011
'to store count in a document variable
'and improve document type handling
Dim strVer As String
Dim strDate As String
Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim oVars As Variables
Dim strFileType As WdDocumentType
Dim strVersionName As String
Dim intPos As Long
Dim sExt As String
Dim strNewFolderName As String
Set oVars = ActiveDocument.Variables
strDate = Format((Date), "dd MMM yyyy")
If Len(Dir(strPath & strNewFolderName, vbDirectory)) = 0 Then
MkDir (strPath & strNewFolderName)
End If
With ActiveDocument
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, ".do"))
If intPos = 0 Then 'No version number
intPos = InStrRev(strFile, ".do") '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 = "doc"
strFileType = 0
Case Is = "docx"
strFileType = 12
Case Is = "docm"
strFileType = 13
Case Is = "dot"
strFileType = 1
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
If strVer = "" Then 'Variable does not exist
oVars("VarVersion").Value = "0" 'So create it
GoTo Start:
End If
On Error GoTo 0
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(Now, "hh-nn") & Chr(46) & sExt
strNewPath = strPath & "\" & strNewFolderName & "\" & strFile & " - " & strDate & _
" - Rev " & Format(Val(strVer), "00# ") _
& Format(Time(), "hh-mm") & Chr(46) & sExt
'and save a copy of the file with that name
ActiveDocument.SaveAs strNewPath
ActiveDocument.SaveAs strVersionName, strFileType
Exit Sub
CancelledByUser: 'Error handler
MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
I need the macro to create a directory called superseded if one does not already exist and then to save the file in main directory and superseded directory. Then to "kill" the previous file from the main directory, and leave the current file in the directory.
BTW I have an excel macro which does this.
The macro for word is posted below:
Sub SaveNumberedVersion()
'Graham Mayor 15 Jan 2006
'Completely Revised 18 January 2011
'to store count in a document variable
'and improve document type handling
Dim strVer As String
Dim strDate As String
Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim oVars As Variables
Dim strFileType As WdDocumentType
Dim strVersionName As String
Dim intPos As Long
Dim sExt As String
Dim strNewFolderName As String
Set oVars = ActiveDocument.Variables
strDate = Format((Date), "dd MMM yyyy")
If Len(Dir(strPath & strNewFolderName, vbDirectory)) = 0 Then
MkDir (strPath & strNewFolderName)
End If
With ActiveDocument
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, ".do"))
If intPos = 0 Then 'No version number
intPos = InStrRev(strFile, ".do") '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 = "doc"
strFileType = 0
Case Is = "docx"
strFileType = 12
Case Is = "docm"
strFileType = 13
Case Is = "dot"
strFileType = 1
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
If strVer = "" Then 'Variable does not exist
oVars("VarVersion").Value = "0" 'So create it
GoTo Start:
End If
On Error GoTo 0
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(Now, "hh-nn") & Chr(46) & sExt
strNewPath = strPath & "\" & strNewFolderName & "\" & strFile & " - " & strDate & _
" - Rev " & Format(Val(strVer), "00# ") _
& Format(Time(), "hh-mm") & Chr(46) & sExt
'and save a copy of the file with that name
ActiveDocument.SaveAs strNewPath
ActiveDocument.SaveAs strVersionName, strFileType
Exit Sub
CancelledByUser: 'Error handler
MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
Who is Participating?
Experts Exchange Solution brought to you by
Enjoy your complimentary solution view.
Get every solution instantly with Premium.
Start your 7-day free trial.
I wear a lot of hats...
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.
It's a bit confusing, but try this;
Sub SaveNumberedVersion()
'Graham Mayor 15 Jan 2006
'Completely Revised 18 January 2011
'to store count in a document variable
'and improve document type handling
Dim strVer As String
Dim strDate As String
Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim oVars As Variables
Dim strFileType As WdDocumentType
Dim strVersionName As String
Dim intPos As Long
Dim sExt As String
Dim strNewFolderName As String
Dim strFullName As String
Set oVars = ActiveDocument.Variables
strDate = Format((Date), "dd MMM yyyy")
strNewFolderName = "\superseded"
If Len(Dir(strPath & strNewFolderName, vbDirectory)) = 0 Then
MkDir (strPath & strNewFolderName)
End If
With ActiveDocument
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
strFullName = .FullName 'path & file name
End With
intPos = InStr(strFile, " - ") 'Mark the version number
sExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".do"))
If intPos = 0 Then 'No version number
intPos = InStrRev(strFile, ".do") '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 = "doc"
strFileType = 0
Case Is = "docx"
strFileType = 12
Case Is = "docm"
strFileType = 13
Case Is = "dot"
strFileType = 1
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
If strVer = "" Then 'Variable does not exist
oVars("VarVersion").Value = "0" 'So create it
GoTo Start:
End If
On Error GoTo 0
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(Now, "hh-nn") & Chr(46) & sExt
strNewPath = strPath & "\" & strNewFolderName & "\" & strFile & " - " & strDate & _
" - Rev " & Format(Val(strVer), "00# ") _
& Format(Time(), "hh-mm") & Chr(46) & sExt
'and save a copy of the file with that name
ActiveDocument.SaveAs strNewPath
ActiveDocument.SaveAs strVersionName, strFileType
ActiveDocument.Close wdDoNotSaveChanges
Kill strFullName
Exit Sub
CancelledByUser: 'Error handler
MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
Gives an error at the following line:
ActiveDocument.SaveAs strNewPath
Sorry for short message in lectures all day today.
ActiveDocument.SaveAs strNewPath
Sorry for short message in lectures all day today.
One other thing is that is doesn't make a folder called superseded, it just bypasses that step for some reason.
Hi Guys,
Still having problems with this macro as below;
1 - it doesn't make a directory called superseded it just goes through the steps without creating it
2 - gives an error message at the ActiveDocument.SaveAs strNewPath
3 - unsure whether the kill command works in Word VBA, it works in excel VBA
Any assist would be greatly appreciated
Still having problems with this macro as below;
1 - it doesn't make a directory called superseded it just goes through the steps without creating it
2 - gives an error message at the ActiveDocument.SaveAs strNewPath
3 - unsure whether the kill command works in Word VBA, it works in excel VBA
Any assist would be greatly appreciated
In my first suggestion, I put the folder creation part before the existing path had been established. This version has it later in the code.
If you get an error , tell us what the error is and the line that it occurs on. Thanks
If you get an error , tell us what the error is and the line that it occurs on. Thanks
Sub SaveNumberedVersion()
'Graham Mayor 15 Jan 2006
'Completely Revised 18 January 2011
'to store count in a document variable
'and improve document type handling
Dim strVer As String
Dim strDate As String
Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim oVars As Variables
Dim strFileType As WdDocumentType
Dim strVersionName As String
Dim intPos As Long
Dim sExt As String
Dim strNewFolderName As String
Dim strFullName As String
Set oVars = ActiveDocument.Variables
strDate = Format((Date), "dd MMM yyyy")
strNewFolderName = "\superseded"
With ActiveDocument
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
strFullName = .FullName 'path & file name
End With
If Len(Dir(strPath & strNewFolderName, vbDirectory)) = 0 Then
MkDir (strPath & strNewFolderName)
End If
intPos = InStr(strFile, " - ") 'Mark the version number
sExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".do"))
If intPos = 0 Then 'No version number
intPos = InStrRev(strFile, ".do") '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 = "doc"
strFileType = 0
Case Is = "docx"
strFileType = 12
Case Is = "docm"
strFileType = 13
Case Is = "dot"
strFileType = 1
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
If strVer = "" Then 'Variable does not exist
oVars("VarVersion").Value = "0" 'So create it
GoTo Start:
End If
On Error GoTo 0
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(Now, "hh-nn") & Chr(46) & sExt
strNewPath = strPath & "\" & strNewFolderName & "\" & strFile & " - " & strDate & _
" - Rev " & Format(Val(strVer), "00# ") _
& Format(Time(), "hh-mm") & Chr(46) & sExt
'and save a copy of the file with that name
ActiveDocument.SaveAs strNewPath
ActiveDocument.SaveAs strVersionName, strFileType
Kill strFullName 'delete original file
Exit Sub
CancelledByUser: 'Error handler
MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
Experts Exchange Solution brought to you by
Your issues matter to us.
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
Start your 7-day free trialIt's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word
From novice to tech pro — start learning today.
Experts Exchange Solution brought to you by
Enjoy your complimentary solution view.
Get every solution instantly with Premium.
Start your 7-day free trial.
strDate = Format((Date), "dd MMM yyyy")
I find using the Japanese format (yyyymmdd) means that, if you have multiple files, listing them in alphabetical order would be the same as date order.