![]() |
#1
|
|||
|
|||
![]()
I want to create a macro that will save a document as a new version. Documents in my company are named like "Master Agreement 01 (JPM 04.03.21)" where the "01" is the version number, "JPM" are the initials of the author, and of course "04.03.21" is the date.
I found the code at the bottom of this post on another site, and have been tinkering with it, but I keep getting thrown by InStrRev not finding a string with multiple variables. That is, I would think that the following code would return the version number in the above filename, but it does not. Code:
Sub FileVerTest() Dim VersionExt As String Dim VerFind As String Dim myFileName As String myFileName = ActiveDocument.Name VerFind = "[1-9] & Chr(0)" 'Finds version of current document, assuming doc is named like "[name] 01 ([initials] [date])" VersionExt = Mid(myFileName, InStr(myFileName, VerFind, 2)) MsgBox VersionExt End Sub Here is the code I found elsewhere that I would like to modify for this use. Also, here's a fun challenge, some people at my company use different formats like "Master Agreement02(JPM 04.03.21)" or "Master Agreement 02.1 (JPM 040321)". Once I get the basic code figured out, I think I can modify to meet each of those different naming styles. Code:
Sub SaveNewVersion_Word() 'PURPOSE: Save file, if already exists add a new version indicator to filename 'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault Dim FolderPath As String Dim myPath As String Dim SaveName As String Dim SaveExt As String Dim VersionExt As String Dim Saved As Boolean Dim x As Long Dim todayDate As String Dim myInitials As String myInitials = "DSR" todayDate = Format(Date, "MM.DD.YY") TestStr = "" Saved = False x = 2 'Version Indicator (change to liking) VersionExt = "_v" 'Pull info about file On Error GoTo NotSavedYet myPath = ActiveDocument.FullName myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1) FolderPath = Left(myPath, InStrRev(myPath, "\")) SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, ".")) On Error GoTo 0 'Determine Base File Name If InStr(1, myFileName, VersionExt) > 1 Then myArray = Split(myFileName, VersionExt) SaveName = myArray(0) Else SaveName = myFileName End If 'Test to see if file name already exists If FileExist(FolderPath & SaveName & SaveExt) = False Then ActiveDocument.SaveAs FolderPath & SaveName & SaveExt Exit Sub End If 'Need a new version made Do While Saved = False If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then ActiveDocument.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt Saved = True Else x = x + 1 End If Loop 'New version saved MsgBox "New file version saved (version " & x & ")" Exit Sub 'Error Handler NotSavedYet: MsgBox "This file has not been initially saved. " & _ "Cannot save a new version!", vbCritical, "Not Saved To Computer" End Sub |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Automatically format specific parts of a word document | Christothex | Word VBA | 3 | 10-19-2019 09:06 PM |
Save Document with Specific Text | mtagliaferri | Word | 3 | 03-17-2018 04:10 PM |
![]() |
sleake | Word | 7 | 08-06-2015 03:52 PM |
![]() |
musawwir | Word | 1 | 11-05-2012 05:20 PM |
Can't save word document in anything but read format | Stuckie | Word | 0 | 01-21-2010 12:46 PM |