Consulting

Results 1 to 11 of 11

Thread: Attaching newly created PDF files in Outlook (from Word)

  1. #1

    Attaching newly created PDF files in Outlook (from Word)

    Hello all,

    I am trying to get a Word document to create a PDF of certain specified pages of the current document and then attach it to an email generated in Outlook.

    Weirdly, the code below works fine if the path listed in filename already exists. It adds it as an attachment in Outlook without a problem. But if the application.printout code below creates a completely new PDF, Word shows the error message:

    Run-time error '-2147024894 (80070002)'; Cannot find this file. Verify the path and file name are correct.

    When I run the fileexist function below immediately after running Application.printout, it confirms that the application.printout code does not print the PDF until after the entire code has completed. That explains why Outlook has trouble finding the file.

    Does anybody know how to get around this problem/get Word to print the PDF page immediately so that the attachment can be added to Outlook without errors?

    N.B. ActiveDocument.ExportAsFixedFormat for creating the PDF is not an option as far as I can tell, since the PDF I am creating will have scattered pages, not a range of pages from X to Y.

    Many thanks in advance for your contributions!


    Dim OlApp As Outlook.Application
    Dim ObjMail As Outlook.MailItem
    Dim filename As String
    filename = "C:\Users\Davec\Downloads\Trial\Bop.pdf"

    ActivePrinter = "Microsoft Print to PDF"
    Application.PrintOut range:=wdPrintAllDocument, Append:=False, Item:= _
    wdPrintDocumentWithMarkup, Copies:=1, pages:="", PageType:= _
    wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=True, _
    PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0, OutputFileName:=filename


    'MsgBox FileExist(filename)


    Set OlApp = Outlook.Application
    Set ObjMail = OlApp.CreateItem(olMailItem)
    ObjMail.Attachments.Add Source:=filename
    Set ObjMail = Outlook.ActiveInspector.CurrentItem
    ObjMail.Recipients.ResolveAll

  2. #2
    The process will not work with a path that doesn't exist, so create it

    Sub Macro1()
    Dim OlApp As Object
    Dim ObjMail As Object
    Dim sPath As String
    Dim sFilename As String
    
    
        sPath = Environ("USERPROFILE") & "\Downloads\Trial\"
        sFilename = sPath & "Bop.pdf"
        CreateFolders sPath
    
        ActiveDocument.ExportAsFixedFormat OutputFileName:=sFilename, _
                                           ExportFormat:=wdExportFormatPDF, _
                                           OpenAfterExport:=False, _
                                           OptimizeFor:=wdExportOptimizeForPrint, _
                                           Range:=wdExportAllDocument, from:=1, To:=1, _
                                           Item:=wdExportDocumentContent, _
                                           IncludeDocProps:=True, _
                                           KeepIRM:=True, _
                                           CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                           DocStructureTags:=True, _
                                           BitmapMissingFonts:=True, _
                                           UseISO19005_1:=False
    
        Set OlApp = CreateObject("Outlook.Application")
        Set ObjMail = OlApp.CreateItem(0)
        With ObjMail
            .Attachments.Add sFilename
            .Recipients.ResolveAll
            .Display
        End With
    End Sub
    
    Private Sub CreateFolders(strPath As String)
    'A Graham Mayor/Greg Maxey AddIn Utility Macro
    Dim oFSO As Object
    Dim lng_PathSep As Long
    Dim lng_PS As Long
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        lng_PathSep = InStr(3, strPath, "\")
        If lng_PathSep = 0 Then GoTo lbl_Exit
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Do
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
            If lng_PathSep = 0 Then Exit Do
            If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
        Loop
        Do Until lng_PathSep = 0
            If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
                oFSO.CreateFolder Left(strPath, lng_PathSep)
            End If
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        Loop
    lbl_Exit:
        Set oFSO = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Hi Graham,

    Thanks for this but it doesn't quite fit the bill because I need a solution using Application.PrintOut, not ExportAsFixedFormat, simply because the pages I'll be printed will be scattered and not a range and I understand that ExportAsFixedFormat only prints ranges.

    When I apply the solution above to the Application.PrintOut method, I get the same problem as before.

  4. #4
    It works just as well with the PrintOut method if you get the syntax right

    Sub Macro1()
    Dim OlApp As Object
    Dim ObjMail As Object
    Dim sPath As String
    Dim sFilename As String
    Dim sPrinter As String
    
        With Dialogs(wdDialogFilePrintSetup)
            sPrinter = .Printer
            .Printer = "Microsoft Print to PDF"
            .DoNotSetAsSysDefault = True
            .Execute
        End With
    
        sPath = Environ("USERPROFILE") & "\Downloads\Trial\"
        sFilename = sPath & "Bop.pdf"
        CreateFolders sPath
    
        ActiveDocument.PrintOut Range:=wdPrintAllDocument, _
                                Append:=False, Item:=wdPrintDocumentWithMarkup, _
                                copies:=1, _
                                Pages:="", _
                                PageType:=wdPrintAllPages, _
                                collate:=True, _
                                Background:=True, _
                                PrintToFile:=True, _
                                PrintZoomColumn:=0, _
                                PrintZoomRow:=0, _
                                PrintZoomPaperWidth:=0, _
                                PrintZoomPaperHeight:=0, _
                                OutputFileName:=sFilename
    
        With Dialogs(wdDialogFilePrintSetup)
            .Printer = sPrinter
            .Execute
        End With
    
        Set OlApp = CreateObject("Outlook.Application")
        Set ObjMail = OlApp.CreateItem(0)
        With ObjMail
            .Attachments.Add sFilename
            .Recipients.ResolveAll
            .Display
        End With
    End Sub
    
    Private Sub CreateFolders(strPath As String)
    'A Graham Mayor/Greg Maxey AddIn Utility Macro
    Dim oFSO As Object
    Dim lng_PathSep As Long
    Dim lng_PS As Long
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        lng_PathSep = InStr(3, strPath, "\")
        If lng_PathSep = 0 Then GoTo lbl_Exit
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Do
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
            If lng_PathSep = 0 Then Exit Do
            If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
        Loop
        Do Until lng_PathSep = 0
            If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
                oFSO.CreateFolder Left(strPath, lng_PathSep)
            End If
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        Loop
    lbl_Exit:
        Set oFSO = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Hi Graham,

    Thanks again for taking your time to look at this. The kindness of strangers on this site never ceases to amaze me.

    I copy-pasted in your code, ran it and I'm still getting the same result. Two things that jump to mind:

    - Could it be something about my version of Word? I'm on version 1908 (11929.20776, semi-annual channel). I doubt it, but I'm throwing it out there.
    - Finally, your code "Sub CreateFolders" creates a new folder (or in my case not new, since the "Trial" folder already exists). What the code seems to struggle to do though is to find the PDF file that has just been created. If, for e.g., I have a file already in the Trial folder labelled "Bop.pdf", it finds the PDF and attaches it to the Outlook email message. However, the file it attaches is the former "Bop.pdf", not the one that has just been created through the "PrintOut" method.

    Ultimately what is happening is that the PrintOut code seems to get run only once all other code in the macro is complete. Which is bizarre.

  6. #6
    Hello,

    I think I may have found the issue and it turns out that it's actually related to my printer settings.

    When I removed the OutputFileName part of the PrintOut method, I noticed that the file extension that it prompted me with was ".prn" not ".pdf". The only problem now is that I can't get it to autoprint to PDF, even though it's not got save to file enabled and appears to be associated with the correct port (POSTPROMPT: localport).

    https://www.winhelponline.com/blog/m...-does-nothing/

  7. #7
    Nope, that was a false dawn. I got it to print as .pdf instead of .prn by reinstalling "Microsoft Print to PDF", but it hasn't helped. I'm still thinking the problem is the one mentioned two posts ago, namely:

    What the code seems to struggle to do though is to find the PDF file that has just been created. If, for e.g., I have a file already in the Trial folder labelled "Bop.pdf", it finds the PDF and attaches it to the Outlook email message. However, the file it attaches is the former "Bop.pdf", not the one that has just been created through the "PrintOut" method.

  8. #8
    Hmmmm. Let's lose the CreateFolders and the folder in sPath and use the Windows Temp folder instead. I have tested the following repeatedly and it has not crashed yet. I have added a couple of lines to reset the printer and to delete the temporary file.

    Sub Macro1()
    Dim OlApp As Object
    Dim ObjMail As Object
    Dim sPath As String
    Dim sFilename As String
    Dim sPrinter As String
    Dim oFSO As Object
    
        With Dialogs(wdDialogFilePrintSetup)
            sPrinter = .Printer
            .Printer = "Microsoft Print to PDF"
            .DoNotSetAsSysDefault = True
            .Execute
        End With
    
        sPath = Environ("TEMP") & "\"
        sFilename = sPath & "Bop.pdf"
        
        ActiveDocument.PrintOut Range:=wdPrintAllDocument, _
                                Append:=False, Item:=wdPrintDocumentWithMarkup, _
                                copies:=1, _
                                Pages:="", _
                                PageType:=wdPrintAllPages, _
                                collate:=True, _
                                Background:=True, _
                                PrintToFile:=True, _
                                PrintZoomColumn:=0, _
                                PrintZoomRow:=0, _
                                PrintZoomPaperWidth:=0, _
                                PrintZoomPaperHeight:=0, _
                                OutputFileName:=sFilename
    
        With Dialogs(wdDialogFilePrintSetup)
            .Printer = sPrinter
            .DoNotSetAsSysDefault = False
            .Execute
        End With
    
        Set OlApp = CreateObject("Outlook.Application")
        Set ObjMail = OlApp.CreateItem(0)
        With ObjMail
            .Attachments.Add sFilename
            .Recipients.ResolveAll
            .Display
        End With
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        If oFSO.FileExists(sFilename) Then Kill sFilename
        Set oFSO = Nothing
        Set ObjMail = Nothing
        Set OlApp = Nothing
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    It was a good idea but still no cigar, unfortunately.

    Essentially the Outlook part is irrelevant. The key thing is to get "FileExist(sFilename)" to show up as true. If you run the macro below, does it come up as true on your computer? If it does, it means that there is something specific about my settings. If not, then there is probably something specific about the PrintOut function.

    Sub Macro1()
    Dim OlApp As Object
    Dim ObjMail As Object
    Dim sPath As String
    Dim sFilename As String
    Dim sPrinter As String
    Dim oFSO As Object


    With Dialogs(wdDialogFilePrintSetup)
    sPrinter = .Printer
    .Printer = "Microsoft Print to PDF"
    .DoNotSetAsSysDefault = True
    .Execute
    End With


    sPath = Environ("TEMP") & ""
    sFilename = sPath & "Bop.pdf"

    ActiveDocument.PrintOut range:=wdPrintAllDocument, _
    Append:=False, Item:=wdPrintDocumentWithMarkup, _
    Copies:=1, _
    pages:="", _
    PageType:=wdPrintAllPages, _
    collate:=True, _
    Background:=True, _
    PrintToFile:=True, _
    PrintZoomColumn:=0, _
    PrintZoomRow:=0, _
    PrintZoomPaperWidth:=0, _
    PrintZoomPaperHeight:=0, _
    OutputFileName:=sFilename
    MsgBox FileExist(sFilename)
    End Sub

  10. #10
    If you get the syntax right it works. The following when run for the first time, should give you two messages boxes. The first may either be true or false (depending whether the file is already present). The second should be true.
    Run it again and the first box should be false because the macro deletes the file, the second true.

    Sub Macro1()
    Dim OlApp As Object
    Dim ObjMail As Object
    Dim sPath As String
    Dim sFilename As String
    Dim sPrinter As String
    Dim oFSO As Object
    
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        MsgBox oFSO.FileExists(sFilename)
    
        With Dialogs(wdDialogFilePrintSetup)
            sPrinter = .Printer
            .Printer = "Microsoft Print to PDF"
            .DoNotSetAsSysDefault = True
            .Execute
        End With
    
    
        sPath = Environ("TEMP") & ""
        sFilename = sPath & "Bop.pdf"
    
        ActiveDocument.PrintOut Range:=wdPrintAllDocument, _
                                Append:=False, Item:=wdPrintDocumentWithMarkup, _
                                copies:=1, _
                                Pages:="", _
                                PageType:=wdPrintAllPages, _
                                collate:=True, _
                                Background:=True, _
                                PrintToFile:=True, _
                                PrintZoomColumn:=0, _
                                PrintZoomRow:=0, _
                                PrintZoomPaperWidth:=0, _
                                PrintZoomPaperHeight:=0, _
                                OutputFileName:=sFilename
        MsgBox oFSO.FileExists(sFilename)
    
        Kill sFilename
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    Hi Graham,

    The logic is sound, but for some reason, I get two falses falses on the first occasion. Thereafter, I get a false then a positive, as you predict.

    Could the problem be that PrintOut takes a while to complete, but the code moves onto the Outlook phase before the document has really been "printed" and saved to a folder? I tried adding a "wait" command for 10 seconds but it didn't help things.

    I'm at a loss what else to try...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •