Sending Email with Signature

[Purdue2479]

I am trying to use the below code to send an email automatically with the signature included. Any suggestions on how I can merge these two pieces of code? Currently, When I run them, it sends the email with the attachment but I cannot get it to include the signature in the body. Thanks.

Sub File_Zip_Mail()
'This sub will send a file (copy of the Activeworkbook).
'It save and zip the workbook before mailing it with a date/time stamp.
'After the zip file is sent the zip file and the workbook will be deleted from your hard disk.
    Dim PathWinZip As String, FileNameZip As String, File_Name_mdb As String
    Dim ShellStr As String, strDate As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    PathWinZip = "C:\program files\winzip\"
    'This will check if this is the path where WinZip is installed.
    If Dir(PathWinZip & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If
 
    ' Build the date/Time string
    strDate = Format(Now, "mm-dd-yyyy")
 
    ' Build the path and name for the zip file
    FileNameZip = Application.CurrentProject.Path & "\" & "text" & " " & strDate & ".zip"
 
    ' Build the path and name for the mdb file
    File_Name_mdb = Application.CurrentProject.Path & "\" & "text" & ".mdb"
 
    'Zip the file
    ShellStr = PathWinZip & "Winzip32 -min -a" _
             & " " & Chr(34) & FileNameZip & Chr(34) _
             & " " & Chr(34) & File_Name_mdb & Chr(34)
    ShellAndWait ShellStr, vbHide

    'Send the File
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Call InsertSig("Eric's Signature")
    With OutMail
        .To = "allene2@roche.com"
        .CC = ""
        .BCC = ""
        .Subject = "NCPDP Store List"
        .Body = "text, " & _
               vbCrLf & vbCrLf & "text" & Format(Now, "mmmm") & ".  text."
        .Attachments.Add FileNameZip
        .send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
 End Sub

 Sub InsertSig(strSigName As String)
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector
    ' requires a project reference to the
    ' Microsoft Word library
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
    ' requires a project reference to the
    ' Microsoft Office library
    Dim objCB As Office.CommandBar
    Dim objCBP As Office.CommandBarPopup
    Dim objCBB As Office.CommandBarButton
    Dim colCBControls As Office.CommandBarControls
    On Error Resume Next
    
    Set objInsp = Outlook.Application.ActiveInspector
    If Not objInsp Is Nothing Then
        Set objItem = objInsp.CurrentItem
        If objItem.Class = olMail Then  ' editor is WordMail
            If objInsp.EditorType = olEditorWord Then
                ' next statement will trigger security prompt
                ' in Outlook 2002 SP3
                Set objDoc = objInsp.WordEditor
                Set objSel = objDoc.Application.Selection
                If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then
                    objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig"
                End If
                objSel.GoTo What:=wdGoToBookmark, Name:="_MailAutoSig"
                Set objCB = objDoc.CommandBars("AutoSignature Popup")
                If Not objCB Is Nothing Then
                    Set colCBControls = objCB.Controls
                End If
            Else ' editor is not WordMail
                ' get the Insert | Signature submenu
                Set objCBP = Outlook.Application.ActiveInspector.CommandBars.FindControl(, 31145)
                If Not objCBP Is Nothing Then
                    Set colCBControls = objCBP.Controls
                End If
            End If
        End If
        If Not colCBControls Is Nothing Then
            For Each objCBB In colCBControls
                If objCBB.Caption = strSigName Then
                    objCBB.Execute ' **** see remarks
                    Exit For
                End If
            Next
        End If
    End If
    
    Set objInsp = Nothing
    Set objItem = Nothing
    Set objDoc = Nothing
    Set objSel = Nothing
    Set objCB = Nothing
    Set objCBB = Nothing
    
End Sub

 

[Purdue2479]

I ended up taking a different route. Below is the solution I used.

 Function Get_Signature(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    Get_Signature = ts.ReadAll
    ts.Close
End Function


Sub File_Zip_Mail()
'This sub will send a file (copy of the Activeworkbook).
'It save and zip the workbook before mailing it with a date/time stamp.
'After the zip file is sent the zip file and the workbook will be deleted from your hard disk.
    Dim PathWinZip As String, FileNameZip As String, File_Name_mdb As String
    Dim ShellStr As String, strDate As String
    Dim OutApp As Object
    Dim Signature As String, SigString As String
     
    PathWinZip = "C:\program files\winzip\"
    'This will check if this is the path where WinZip is installed.
    If Dir(PathWinZip & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If
 
    ' Build the date/Time string
    strDate = Format(Now, "mm-dd-yyyy")
 
    ' Build the path and name for the zip file
    FileNameZip = Application.CurrentProject.Path & "\" & "text& " " & strDate & ".zip"
 
    ' Build the path and name for the mdb file
    File_Name_mdb = Application.CurrentProject.Path & "\" & "text" & ".mdb"
 
    'Zip the file
    ShellStr = PathWinZip & "Winzip32 -min -a" _
             & " " & Chr(34) & FileNameZip & Chr(34) _
             & " " & Chr(34) & File_Name_mdb & Chr(34)
    ShellAndWait ShellStr, vbHide

    'Send the File
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    SigString = "signature path"  

    If Dir(SigString) <> "" Then
        Signature = Get_Signature(SigString)
    Else
        Signature = ""
    End If
 
    On Error Resume Next

    With OutMail
        .To = "email"
        .CC = ""
        .BCC = ""
        .Subject = "text
        .HTMLBody = "<html><body>Catherine, <br><br>" & _
                    "text" & _
               "&nbsp text<br><br></body></html>" & Signature
        .Attachments.Add FileNameZip
        .Display
        .send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
 End Sub