WORD VBA Open outlook and Send saved PDF Attachment

[flymansky248]

Hi All

I Was hoping you could help. I'm no expert with VBA but I have been trying to achieve something where on clicking the button it saves the form I made in Word as a PDF in a predefined folder with the date. It then saves the PDF in the destination folder, closes the word document and does not save changes (ensurer the next user finds a blank form to use and prevents others from saving over it).

See the code below for the VBA script to save as PDF and close. I now want to further develop it 2 ways - 1) is before emailing have an otion box saying Caution this will send email. Is the document ready?" On Yes it will send the email and on No it will close the vba and go back to the word document.

Please can you help me write the code for it to open outlook and attach the PDF and send the email it saved with the file name (based on Text added to the document) to the file location "D:\Home\AirDocuments\S20 spray"

Im really struggling with it



Private Sub CommandButton1_Click()


Shapes(1).Visible = msoFalse


With ActiveDocument
.SaveAs2 FileName:="D:\Home\AirDocuments\" & "\S20 Spray\" & "Checklist " & _
.SelectContentControlsByTitle("Flight")(1).Range.Text & Space(5) & _
Format(Now(), "dd-mm-yyyy") & ".PDF", _
FileFormat:=wdFormatPDF

.Shapes(1).Visible = msoTrue

MsgBox "File saved to D:\Home\AirDocuments\S20 spray\"
MsgBox "File will close!"
Application.Documents.Close SaveChanges:=wdDoNotSaveChanges
End With
End Sub

[gmayor]

The following is a slight variation on code I have posted before. Please read and observe the comment at the top of the macro as it won't otherwise work.
Rather than use a document with code, I would suggest that you save the document as a macro enabled template and create new documents from it. That will avoid the danger of overwriting.


Sub Send_As_PDF_Attachment()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Oct 2020

'Send the document as a PDF attachment in an Outlook Email message
'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook correctly if it is closed.

Const strPath As String = "D:\Home\AirDocuments\S20 spray\"
Dim olApp As Object
Dim oItem As Object
Dim oDoc As Document
Dim strName As String
Dim strPDF As String
Dim strSubject As String
Dim olInsp As Object
Dim wdDoc As Document
Dim oRng As Range

Set oDoc = ActiveDocument
On Error GoTo err_Handler:
If oDoc.SelectContentControlsByTitle("Flight")(1).ShowingPlaceholderText = True Then
MsgBox "Complete Flight!", vbCritical
oDoc.SelectContentControlsByTitle("Flight")(1).Range.Select
GoTo lbl_Exit
End If

strName = oDoc.SelectContentControlsByTitle("Flight")(1).Range.Text & Space(5) & _
Format(Now(), "dd-mm-yyyy") & ".pdf"
strPDF = strPath & strName
'And save the document as PDF
oDoc.ExportAsFixedFormat OutputFileName:=strPDF, _
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

strSubject = Split(strPDF, "\")(UBound(Split(strPDF, "\")))
strSubject = Split(strSubject, ".")(0)
'Get Outlook (see comment at top of macro)
Set olApp = OutlookApp()
On Error GoTo 0
'Create a new mailitem
Set oItem = olApp.CreateItem(0)

With oItem
.to = "someone@somewhere.com"
.Subject = strSubject
.attachments.Add strPDF
.BodyFormat = 2 'olFormatHTML
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.Collapse 1
oRng.Text = "Please find enclosed document."
End With
'Now close the document without saving as we have finished with it
If MsgBox("Have you finished with the document?", vbYesNo) = vbYes Then
oDoc.Close 0
End If
lbl_Exit:
Set oDoc = Nothing
Set oItem = Nothing
Set olApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
err_Handler:
Err.Clear
GoTo lbl_Exit
End Sub