Microsoft Office Forums - View Single Post

gmayor · 08-31-2017, 10:41 PM

You don't need to redefine all the string variables in your second macro, just pass those that you need from the first to the second. You can create a temporary PDF file that contains only the first page and attach that to the e-mail.

It is better to test for the placeholder text when validating content controls and note that while Set oOutlookApp = GetObject(, "Outlook.Application") is a valid way of accessing outlook if it is open, Set oOutlookApp = CreateObject("Outlook.Application") does not allow Outlook to behave as you might expect. You should therefore use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm to start Outlook.

This is especially so if you want to add body text to the e-mail as shown below. If you require more information about this it is linked from the web page.

The following will attach the first page of the document in PDF format and send it to the named recipient. I have added a couple of lines of code to validate the filename, in case someone enters an invalid character in the Title control

Code:

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