CODEWITHSUNDEEP
vbaexcelpdfoutlook
A Elsheikh
A Elsheikh

Reputation: 89

Saving Excel file as PDF then send by Outlook as Attachment but no signature in the messge

I have some Excel VBA code which save active sheet as PDF then attach that PDF file to outlook new mail everything works fine except the signature in outlook when the code starts outlook and new message it does not show the signature despite its in HTML and I can already insert it manually. so any adjustment to the code will be appreciated.

Sub Send_To_Pdf()
Dim PdfPath As String
Dim BoDy As String

BoDy = Msg = "Dear Mr. " & vbCrLf & vbCrLf & "Good Day" & vbCrLf & vbCrLf & "Kindly find the attahched P.O to be delivered to " & Cells(10, 12)


PdfPath = Save_as_pdf
EnvoiMail Right(PdfPath, InStr(1, StrReverse(PdfPath), "\") - 1), "[email protected];[email protected]", , , BoDy, 1, PdfPath
End Sub

Public Function Save_as_pdf() As String
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

Set FSO = CreateObject("Scripting.FileSystemObject")

s(0) = "C:\Users\" & Environ("UserName") & "\Desktop\" & ThisWorkbook.Name

If FSO.FileExists(ThisWorkbook.FullName) Then
    '//Change Excel Extension to PDF extension in FilePath
    s(1) = FSO.GetExtensionName(s(0))

    If s(1) <> "" Then
        s(1) = "." & s(1)
        sNewFilePath = Replace(s(0), s(1), ".pdf")

        '//Export to PDF with new File Path
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNewFilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
Else
    '//Error: file path not found
    MsgBox "Error: this workbook may be unsaved.  Please save and try again."
End If

Set FSO = Nothing

Save_as_pdf = sNewFilePath

End Function


Sub EnvoiMail(Subject As String, Destina As String, Optional CCdest As String, Optional CCIdest As String, Optional BoDyTxt As String, Optional NbPJ As Integer, Optional PjPaths As String)
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)

  Dim PJ() As String
  PJ() = Split(PjPaths, ";")

  With MonMessage
      .Subject = Subject      '"Je suis content"
      .To = Destina           '"[email protected];[email protected]"
      .cc = CCdest            '"[email protected];[email protected]"
      .bcc = CCIdest          '"[email protected];[email protected]"
      .BoDy = BoDyTxt
        If PjPaths <> "" And NbPJ <> 0 Then
            For i = 0 To NbPJ - 1
                'MsgBox PJ(I)
              .Attachments.Add PJ(i)      '"C:\Mes Documents\Zoulie Image.gif"
            Next i
        End If
      .display
      '.send                        '.Attachments.Add ActiveWorkbook.FullName
  End With                        '?plusieurs?MonMessage.Attachments.Add "D:\Prof\Janvier\Base clients.mdb"

  Set MonOutlook = Nothing
End Sub

Upvotes: 0

Views: 1835

Answers (2)

A Elsheikh
A Elsheikh

Reputation: 89

thanks Eugene Astafiev i changed some of the code and i got it worked after all

the changed part is as following:

Sub EnvoiMail(Subject As String, Destina As String, Optional CCdest As String, Optional CCIdest As String, Optional BoDyTxt As String, Optional NbPJ As Integer, Optional PjPaths As String) Dim MonOutlook As Object Dim MonMessage As Object Dim strbody As String 'i added this part <<>>>'

Set MonOutlook = CreateObject("Outlook.Application") Set MonMessage = MonOutlook.CreateItem(0) strbody = "Hello" ' i put my messages here as well which i change it in my main code to get values from cells <<<<>>>'

Dim PJ() As String PJ() = Split(PjPaths, ";")

With MonMessage .Display ' <<<<< the most important part of the code which solved 50% of the problem >>>>'

  .Subject = Subject
  .To = Destina
  .CC = CCdest
  .BCC = CCIdest
  .HTMLBoDy = strbody & "<br>" & .HTMLBoDy  ' <<<< the second import part of the code and solved the other 50% >>>>> '

    If PjPaths <> "" And NbPJ <> 0 Then
        For i = 0 To NbPJ - 1
            'MsgBox PJ(I)
          .Attachments.Add PJ(i)
        Next i
    End If
  .Display
  '.send

End With

Set MonOutlook = Nothing End Sub

Upvotes: 0

Eugene Astafiev
Eugene Astafiev

Reputation: 49445

After a new message is created you need to insert a new text before the default signature (not to overwrite it), for example:

.BoDy = BoDyTxt

The default signature will be erased in that case.

.Body = BoDyTxt & .Body

In that case the text will be inserted in the beginning of the message leaving the signature as is.

The Outlook object model provides three different ways for working with item bodies:

  1. Body - a plain text.
  2. HTMLBody - an HTML markup.
  3. The Word Editor. Outlook uses Word as an email editor, so you can use it to format the email message. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body.

You can read more about all these ways in the Chapter 17: Working with Item Bodies in MSDN.

Upvotes: 2

Related Questions