Option Explicit

Sub SaveAndSend()
Dim strPDF As String
Dim strDate As String
Dim strNoti As String
Dim strTitle As String
Dim orng As Range
Dim strFilename As String
Dim arrInvalid() As String
Dim lngIndex As Long

    If ActiveDocument.SelectContentControlsByTag("EventDate").Item(1).ShowingPlaceholderText = True Then
        MsgBox "Please select an event date.", vbExclamation, "Date Error"
        Exit Sub
    End If

    strDate = ActiveDocument.SelectContentControlsByTag("EventDate").Item(1).Range.Text

    If IsDate(strDate) Then
        strDate = Format(strDate, "yyyy-mm-dd")
    Else
        MsgBox "Please select an event date.", vbExclamation, "Date Error"
        Exit Sub
    End If

    If ActiveDocument.SelectContentControlsByTag("NotificationNumber").Item(1).ShowingPlaceholderText = True Then
        MsgBox "Please enter a valid notification number.", vbExclamation, "Notification Error"
        Exit Sub
    End If

    strNoti = ActiveDocument.SelectContentControlsByTag("NotificationNumber").Item(1).Range.Text

    If IsNumeric(strNoti) = False Then
        MsgBox "Please enter a valid notification number.", vbExclamation, "Notification Error"
        Exit Sub
    End If

    If ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).ShowingPlaceholderText = True Then
        MsgBox "Please enter short text.", vbExclamation, "Title Not Entered", "Title Error"
        Exit Sub
    End If
    strTitle = ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).Range.Text

    strFilename = strDate & " " & strNoti & " " & strTitle
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")

    'Remove any illegal filename characters
    For lngIndex = 0 To UBound(arrInvalid)
        strFilename = Replace(strFilename, Chr(arrInvalid(lngIndex)), Chr(95))
    Next lngIndex
    strFilename = strFilename & ".pdf"

    'next section not required for attachment
    ActiveDocument.SaveAs FileName:= _
                          "https://spo.bhpb.com/sites/COLMTAmac...Notifications/" & strFilename, FileFormat:=wdFormatPDF
    ActiveDocument.SaveAs FileName:= _
                          "\\necmacfil01\bcc_data\Transfer\Sue Jones\NHSEC_DIR_CTRL_DOCS_(MRE)\" & strFilename, FileFormat:=wdFormatPDF
    'end of section  not required for attachment

    'Get the first page of the document
    Set orng = ActiveDocument.Range
    orng.Collapse 1
    orng.Select
    orng.End = ActiveDocument.Bookmarks("\page").Range.End - 1
    'and export it as PDF
    orng.ExportAsFixedFormat OutputFilename:=Environ("TEMP") & Chr(92) & strFilename, _
                             ExportFormat:=wdExportFormatPDF, _
                             OpenAfterExport:=False
    'Send the message with the first page PDF
    SendDocumentAsAttachment Environ("TEMP") & Chr(92) & strFilename, strTitle, strDate, strNoti
    Set orng = Nothing
End Sub

Sub SendDocumentAsAttachment(strFilename As String, _
                             strTitle As String, _
                             strDate As String, _
                             strNoti As String)
'pass the values from the calling macro
Dim bStarted As Boolean
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Document
Dim orng As Range
Dim oOutlookApp As Object

    'You don't need to add the Outlook Object Library to VBA Tools References
    'But you will need the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    'to start Outlook properly

    Set oOutlookApp = OutlookApp()
    Set oItem = oOutlookApp.CreateItem(0)
    With oItem    'and add the detail to it
        .to = "DL-COL-NEC-MACEventNotification@bhpb.com"    'send to this address
        .CC = ""
        .Subject = strDate & " " & strNoti & " " & strTitle    'This is the message subject
        .Attachments.Add strFilename
        .Display 'This line is required
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set orng = wdDoc.Range
        orng.Collapse 1
        orng.Text = "This is the body of the message before the signature"
        '.send 'restore this line after testing
    End With
    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set orng = Nothing
End Sub