Quote:
Originally Posted by gmayor
What you require is not straightforward - especially with variable dates, but the following will be close (albeit it will start renumbering if the date changes) and the first PDF will not be numbered.
Code:
Option Explicit
Sub SaveAsDocX_PDF()
Dim strName As String
Dim strPDF As String
Dim strPath As String
ActiveDocument.Save
If Not ActiveDocument.Path = "" Then
strName = ActiveDocument.Name
strPath = ActiveDocument.Path
strPDF = Format(Date, "yyyymmdd_") & Left(strName, InStrRev(strName, Chr(46)) - 1)
strPDF = PDFNameUnique(strPath, strPDF)
ActiveDocument.SaveAs FileName:=strPath & "\" & strPDF, _
FileFormat:=wdFormatPDF
Else
MsgBox "Document not saved!"
End If
End Sub
Private Function PDFNameUnique(strPath As String, _
strFilename As String) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 03 Nov 2017
Dim lngF As Long: lngF = 1
Dim lngName As Long: lngName = Len(strFilename)
Dim strExtension As String
Do Until Right(strPath, 1) = Chr(92)
strPath = strPath & Chr(92)
Loop
strExtension = ".pdf"
strFilename = Left(strFilename, lngName)
Do While FileExists(strPath & strFilename & strExtension) = True
strFilename = Left(strFilename, lngName) & Format(lngF, "00")
lngF = lngF + 1
Loop
PDFNameUnique = strFilename & strExtension
lbl_Exit:
Exit Function
End Function
Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor
'strFullName is the name with path of the file to check
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFullName) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Set fso = Nothing
Exit Function
End Function
You may find http://www.gmayor.com/SaveVersionsAdd-In.htm and http://www.gmayor.com/save_numbered_versions.htm useful.
|
Hi,
First thanks for your help, this is already really close to what i would like to get. Now i hope someone knows how to 'fix' the restart of versions when saved on an other date. I understand now that the code checks for an exisiting file name.
I could also consider to manualy edit the version, to call my files example_0.0X.docx and the macro would make it 20171106_example_0.0X1.PDF.
So i suppose this post could be considered solved, thank you very much.