Attaching newly created PDF files in Outlook (from Word)

[Davecogz84]

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

[gmayor]

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

[Davecogz84]

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.

[gmayor]

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

[Davecogz84]

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.

[Davecogz84]

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/ms-print-to-pdf-prn-file-does-nothing/

[Davecogz84]

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.

[gmayor]

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

[Davecogz84]

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

[gmayor]

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

[Davecogz84]

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...