Saving and creating PDF at once

DeRoelO · #1 11-02-2017, 06:03 AM

Hello,

I am looking for a VBA that saves my Word file like normal. But when saved to .docx i need a copy of that version in .pdf format. I need to get my versions in .pdf file thats why. Sadly I don't have any experience with creating macros.

For example:

I have a file called example.docx and use the macro to save it. Now it has to create a .pdf file in the same folder. I would like to have it called:

20171101_example01.pdf

Now when i save it again one day later, it should normaly save my .docx file like it always does. And create a .pdf file in the same folder called:

20171102_example02.pdf

If i would save it like 55 times i would have to get this:

20171102_example55.pdf

It would not have to delete the previous versions.
Did somebody wrote anything like this before? Or could anyone help me?

The result should look something like this:

gmayor · #2 11-03-2017, 03:22 AM

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.

FionaMcKenzie · #3 11-03-2017, 07:04 AM

With regards to "But when saved to .docx i need a copy of that version in .pdf format"

Do you mean every time you save the document you create a PDF?
Or is it fine to run the above code manually when you are ready to?

To do the first, you need an Application Events class and to use the BeforeSave event.

DeRoelO · #4 11-06-2017, 03:11 AM

Quote:

Originally Posted by FionaMcKenzie

With regards to "But when saved to .docx i need a copy of that version in .pdf format"

Do you mean every time you save the document you create a PDF?
Or is it fine to run the above code manually when you are ready to?

To do the first, you need an Application Events class and to use the BeforeSave event.

Exactly just that, i need to be able to see what the progress per save is and what what dates it was saved.

DeRoelO · #5 11-06-2017, 04:52 AM

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.

FionaMcKenzie · #6 11-07-2017, 03:14 AM

Hi again,

I was hesitant on the whole Save point... There is a BeforeSave but not an AfterSave event in Word. The only way I could think of doing the PDF save after the Save completed was to evoke a Windows change to evoke the WindowsEvent in Word & do the PDF save then. All very, very mucky. So not a solution! It's such a pity there is no AfterSave event!

However, you can override the Word FileSave process.
Note: This means your program cannot have bugs.

If you SaveAs on an existing file to a new file name, you would have to process your PDF save manually when doing so. But this will trap the save when you want to create your PDF backups.

I've written code for you with comments. You can add this to your template, but be careful with Word overrides.

Let me know if it helps you with your PDF save request though.

Kind regards
Fiona

Option Explicit

Public Sub FileSave()

' Note: FileSave overrides Word's FileSave command!

On Error GoTo ErrorHandler

With ActiveDocument

' Check whether it has a path meaning it's been saved before
If .Path = vbNullString Then

' Show the SaveAs dialog
Word.Dialogs(wdDialogFileSaveAs).Show

Else

' Save the document
.Save
End If

' Was the file saved in the SaveAs Dialog
If .Saved = True Then

' You will need ensure only documents based on this template
' are saved as PDF. Save your source document as a *.dotm
' When you create new instances of the template, this code will run
If .AttachedTemplate = ThisDocument Then

' You don't want to save PDFs of the template, just documents
If LCase(Right(.FullName, 5)) = ".docx" Then

' Not sure if you want to check before saving the PDF?
If MsgBox("Would you like to save a PDF copy?", _
vbYesNo, "Save PDF version") = vbYes Then

' It's active already though
.Activate

' Call the procedure you were given to create the PDF
Call PDFSave.SaveAsDocX_PDF

End If
End If
End If
End If
End With

Exit Sub
ErrorHandler:
' Quite crucial if an error occurs!
MsgBox "An error occurred on FileSave!" & vbCr & vbCr & _
Err.Number & " " & Err.Description, vbOKOnly + vbExclamation, "FileSave Error"
Err.Clear
End Sub

slaycock · #7 11-07-2017, 04:40 AM

A further solution, which might be just as functional, is to just save the file with a suitable timestamp. The macro below should be called from whichever save function of word that you trap/redirect.

Code:

Sub save_doc_with_pdf_timestamp(doc As Document)
   
    Dim myFullName   As String
    Dim myFullNameTS   As String
    
    ' SaveAs2 changes the name of the current document
    ' therefore we need to preserve the current full name
    myFullName = doc.FullName
    myFullNameTS = replace(doc.FullName, ".", Format$(Now(), "-yyyy-mm-dd-hh-mm-ss."))
    ' Saveas2 fails if we don't use the correct file type
    ' change docx to doc if needed.
    myFullNameTS = replace(myFullNameTS, ".docx", ".pdf")
    doc.SaveAs2 filename:=myFullNameTS, FileFormat:=wdFormatPDF
    ' SAVE THE WORD DOCUMENT LAST TO REINSTATE THE FILE NAME.
    doc.SaveAs2 filename:=myFullName
        
End Sub

FionaMcKenzie · #8 11-07-2017, 02:42 PM

Don't worry about my previous comment. It's fine.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Problems with creating and saving word templates	smd89	Word	2	03-30-2016 06:38 AM
Problem with saving as .PDF	benoitbri	Word	5	02-12-2016 07:31 AM
Saving as pdf	danielraviolo	Word	5	06-19-2015 09:46 PM
Saving VBA	skib	PowerPoint	0	02-18-2011 12:59 AM
Saving backup	prestoaa	Outlook	0	12-13-2010 08:35 PM