How to not overwrite default signature with pasted image?

Amna Yasin 0
Viewed 50

My default email signature is overwritten by an embedded image. The signature shows up at first and then the picture takes its place.

I want this code to work for other people. How can I add the default email signature?

Sub Send_Email()

Dim pdfPath As String, pdfName As String

'PDF name same as the workbook.name
pdfName = "VW Fuel Marks_" & Format(Date, "m.d.yyyy")

'PDF save path same as workbook path, where the workbook is saved
pdfPath = ThisWorkbook.Path & "\" & pdfName & ".pdf"

'Selecting sheets (if any of the sheets hidden it will run to an error)
ThisWorkbook.Sheets(Array("Daily Dashboard-Page1", "Daily Dashboard-Page2", "Daily Dashboard-Page3", "Daily Dashboard-Page4")).Select

'Create pdf and open it (if a pdf with a same name is already opened it will run to an error)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, OpenAfterPublish:=True

Application.Worksheets(19).Range("A1:T42").CopyPicture xlScreen, xlPicture

Dim OApp As Object, OMail As Object, Signature As String
Dim cell As Range, S As String, WMBody As String, lFile As Long

Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)

With OMail
    .Display
End With

Signature = OMail.HTMLBody

With OMail
    .To = Range("AG3").Value
    .CC = Range("AG4").Value
    .Subject = Range("A1").Value
    .HTMLBody = Replace(Signature, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & sBody)
    .Attachments.Add pdfPath
    OMail.Display
End With

'.Attachments.Add
Set ins = OMail.GetInspector
'need add reference to Microsoft Word Object Library
Dim doc As Word.Document
Set doc = ins.WordEditor
doc.Select
doc.Application.Selection.Paste
OMail.Display
   
Set OMail = Nothing
Set OApp = Nothing

End Sub
office-automation outlook email vba excel
2 Answers

You need to insert the content right after the opening <body> tag. In that case the rest content will be preserved as is.

With OMail
    .Display
End With

Signature = OMail.HTMLBody

With OMail
    .To = Range("AG3").Value
    .CC = Range("AG4").Value
    .Subject = Range("A1").Value

     ' here you need to find the <body> tag and insert the new content right after it
    .HTMLBody = ...

    .Attachments.Add pdfPath
    OMail.Display
End With

You can use VBA string functions to find the <body> tag and paste the content right after it.

Eugene Astafiev0

You select the body then paste over it.

Set doc = ins.WordEditor
doc.Select
doc.Application.Selection.Paste

Instead paste at the top, in a smaller size.

Set doc = ins.WordEditor
doc.Range(0, 0).Paste

This pastes at the top with size matching your code.

Set doc = ins.WordEditor
Dim wdRange As Word.Range
Set wdRange = doc.Range(0, 0)
wdRange.Select
doc.Application.Selection.Paste
niton0
Related