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