View Single Post
 
Old 01-13-2021, 10:13 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Frankly I wouldn't do it quite like that. First I would use the function referred to in the comment at the start of the code below to open Outlook correctly. You can then use the Word Editor to edit the message body and retain the default signature.
I have made some changes to your code to get the ID number from the CC to eliminate the pasting.
Code:
Option Explicit

Private Sub CommandButton1_Click()
'Graham Mayor - https://www.gmayor.com - Last updated - 14 Jan 2021
'Requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.

Dim strPath As String, sID As String
Dim OL As Object
Dim olInsp As Object
Dim oDoc As Document, wdDoc As Document
Dim oRng As Range
Dim EmailItem As Object

    sID = GetCC
    If sID = "" Then Exit Sub

    strPath = Environ("UserProfile") & "\Desktop\"
    Set oDoc = ActiveDocument
    oDoc.SaveAs2 FileName:=strPath & "CCB Proposal Submission ID # " & sID & ".docx", FileFormat:=wdFormatXMLDocument


    Application.ScreenUpdating = False
    Set OL = OutlookApp
    Set EmailItem = OL.CreateItem(0)

    MsgBox "Your CCB proposal document has been saved to your desktop as 'CCB Proposal Submission ID # " & sID & "'." & vbCr & vbCr & _
           "Click 'OK' to open your submission email draft."

    With EmailItem
        .Subject = Left(oDoc.Name, InStrRev(oDoc.Name, ".") - 1)
        .To = "NAME_REDACTED"
        .CC = "NAME_REDACTED"
        .Attachments.Add oDoc.FullName
        .BodyFormat = 2        'olFormatHTML
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "Greetings," & vbCrLf & vbCrLf & _
                    "Attached please find a CCB proposal submission." & vbCrLf & vbCrLf & _
                    "Please let me know if you have any questions." & vbCrLf & vbCrLf & _
                    "Thank you."
        .Display
    End With

    Application.ScreenUpdating = True

    Set oDoc = Nothing
    Set OL = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olInsp = Nothing

End Sub


Private Function GetCC() As String
Dim oCC As ContentControl
    For Each oCC In ActiveDocument.ContentControls
        If oCC.Title = "SubmissionIDNo" And oCC.Tag = "SubmissionIDNo" Then
            If oCC.ShowingPlaceholderText = True Then
                MsgBox "Enter the SubmissionIDNo"
                oCC.Range.Select
                GoTo lbl_Exit
            Else
                GetCC = oCC.Range.Text
            End If
            Exit For
        End If
    Next oCC
lbl_Exit:
    Set oCC = Nothing
    Exit Function
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote