Can you explain to me why my signature dissapears ?

[sahinbur]

Hi all,

Would be great if you explain to me why my signature dissapears? And how can I get it back?

Sub send_email_with_attachments()

On Error Resume Next

Dim o As Outlook.Application
Set o = New Outlook.Application


Dim omail As Outlook.MailItem

Dim i As Long

For i = 2 To Range("a100").End(xlUp).Row

Set omail = o.CreateItem(olMailItem)

With omail

.Body = "Dear " & Cells(i, 1).Value & vbNewLine & vbNewLine _
& "Please update your file." & vbNewLine _
& "Please feel free to contact me if you need any clarification."
.To = Cells(i, 2).Value
.CC = Cells(i, 3).Value
.Subject = Cells(i, 4).Value
.Attachments.Add Cells(i, 5).Value

.Display

End With

Next

End Sub

[gmayor]

It disappears because you have set the body of the message with your macro. The signature is part of the body.
Use instead the WordEditor inspector to edit the message body - see for example http://www.vbaexpress.com/forum/showthread.php?65222-Sending-email-from-excel-based-on-cell-value

[Paul_Hossler]

This is a macro I made awile ago to send Excel data via Outlook

It has signature code that you might find useful

It's most likely not perfect (:) )so if Graham has suggestions, I'll be glad to take them




' ver 03 10/26/2018
' added existance checks
' made into function, True if successful
' ver 02 10/25/2018
' added sSignatures

Option Explicit
Option Private Module
Const olFormatHTML As Long = 2
Const olFormatPlain As Long = 1
Const olFormatRichText As Long = 3
Const olFormatUnspecified As Long = 0
Const olAppointmentItem As Long = 1
Const olContactItem As Long = 2
Const olDistributionListItem As Long = 7
Const olJournalItem As Long = 4
Const olMailItem As Long = 0
Const olNoteItem As Long = 5
Const olPostItem As Long = 6
Const olTaskItem As Long = 3
Const sDefaultSignature As String = "My Sig.htm"


Dim sSignatureFolder As String, sSignatureFile As String


'Signatures stored in Environ("appdata") & "\Microsoft\Signatures\"
'If NO signature files, generate plain text email and plain text signature
'If 1 signature file, use the .HTM version as signature and generate HTML email
'if more than 1
' use "My Sig.htm" if avaialble
' otherwise generate plain text email and plain text signature
Function SendWithOutlook(emailRecipient As String, _
emailMessage As String, _
Optional emailSubject As String = vbNullString, _
Optional emailAttachmentFile As String = vbNullString) As Boolean

Dim oOutlook As Object
Dim oMailItem As Object
Dim sSignature As Variant
Dim MailFormat As Long
Dim sHtmlBody As String, sPlainBody As String
On Error GoTo EmailError
'see if attachment is there, raise error if not
If Len(emailAttachmentFile) > 0 Then
If Len(Dir(emailAttachmentFile)) = 0 Then Err.Raise vbObject + 1
End If

'see if Signature file is there, raise error if not
sSignatureFolder = Environ("appdata") & "\Microsoft\Signatures\"
If Len(Dir(sSignatureFolder)) = 0 Then Err.Raise vbObject + 2
'get sSignature as text or the count number if not exactly 1
sSignature = Sigs

If IsNumeric(sSignature) Then
If sSignature = 0 Then ' no sSignatures
MailFormat = olFormatPlain

Else 'if more than one, does default exist (My Sig.htm)
sSignatureFile = Dir(sSignatureFolder & sDefaultSignature)
If Len(sSignatureFile) = 0 Then ' if not, then plain text email
MailFormat = olFormatPlain

Else
MailFormat = olFormatHTML
End If
End If

Else
MailFormat = olFormatHTML
End If


'build signatures and format body as HTML or as Plain Text
If MailFormat = olFormatHTML Then
sSignature = CreateObject("Scripting.FileSystemObject").GetFile(sSignature).OpenAsTextStream(1, -2).readall

sHtmlBody = emailMessage & "<hr>Sent " & FormatDateTime(Now, vbLongDate) & " at " & FormatDateTime(Now, vbLongTime) & "<hr><br>"
sHtmlBody = Replace(sHtmlBody, "^", "<br>")

Else
sSignature = vbCrLf & vbCrLf & _
"--------------------------------------------------------------------------" & _
vbCrLf & vbCrLf & _
Application.UserName & _
vbCrLf & vbCrLf & _
"Sent " & FormatDateTime(Now, vbLongDate) & " at " & FormatDateTime(Now, vbLongTime)
sPlainBody = Replace(emailMessage, "^", vbCrLf)
End If

'Set Outlook to current instance, opening if necessary
Set oOutlook = GetObject(, "Outlook.Application")

'create new mail item
Set oMailItem = oOutlook.CreateItem(olMailItem)
With oMailItem
'Returns or sets a semicolon-delimited String list of display names for the To recipients for the Outlook item. Read/write.
.To = emailRecipient
.CC = vbNullString
.BCC = vbNullString
If Len(emailSubject) = 0 Then
.Subject = ThisWorkbook.Name & " -- " & Format(Now, "General Date")
Else
.Subject = emailSubject
End If
If MailFormat = olFormatHTML Then
.BodyFormat = MailFormat
.HtmlBody = sHtmlBody & sSignature

Else
.BodyFormat = MailFormat
.Body = sPlainBody & sSignature
End If
If Len(emailAttachmentFile) > 0 Then .Attachments.Add emailAttachmentFile

.readreceiptrequested = False
.Send
End With
On Error GoTo 0
Set oMailItem = Nothing
Set oOutlook = Nothing

SendWithOutlook = True
Exit Function

EmailError:
If Err.Number = 429 Then
Set oOutlook = CreateObject("Outlook.Application")
Resume Next
Else
SendWithOutlook = False
Set oMailItem = Nothing
Set oOutlook = Nothing
End If

End Function

'if only one sSignature then return the path, if 0 or more than 1, return the count
Function Sigs() As Variant
Dim N As Long
sSignatureFile = Dir(sSignatureFolder & "*.htm")
Do While Len(sSignatureFile) > 0
N = N + 1
sSignatureFile = Dir
Loop
If N = 1 Then
Sigs = sSignatureFolder & Dir(sSignatureFolder & "*.htm")
Else
Sigs = N
End If
End Function

[gmayor]

It's not a question of 'perfect' but whether it works, which is the aim of the game. Frankly it is easier to use the Outlook WordEditor Inspector and then treat the message as a Word document. The example I linked was an over complicated one, with different formatting requirements throughout but the principle is good and it starts by keeping the default signature without having to worry about adding it, or deleting it as with the OP's issue.

[sahinbur]

It's not a question of 'perfect' but whether it works, which is the aim of the game. Frankly it is easier to use the Outlook WordEditor Inspector and then treat the message as a Word document. The example I linked was an over complicated one, with different formatting requirements throughout but the principle is good and it starts by keeping the default signature without having to worry about adding it, or deleting it as with the OP's issue.

Hi Graham,
What would you recommend since I am not native these WordEditor. I couldn't correct my code.

[gmayor]

Based on your code, you would need something like the following - see the note at the top of the macro


Option Explicit

Sub SendWorkBook()
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Jun 2019
'This macro requires the code from
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook

Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim i As Integer

Set oOutlookApp = OutlookApp() 'Use the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook, or it will not work correctly
For i = 2 To Range("a100").End(xlUp).Row
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(0)
With oItem
.Subject = Cells(i, 4).value
.Attachments.Add Cells(i, 5).value
.To = Cells(i, 2).value
.CC = Cells(i, 3).value
.BodyFormat = 2 'html
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor 'access the message body for editing
Set oRng = wdDoc.Range
oRng.Collapse 1 'set a range to the start of the message
'enter the range text
oRng.Text = "Dear " & Cells(i, 1).value & vbCr & vbCr _
& "Please update your file." & vbCr & vbCr _
& "Please feel free to contact me if you need any clarification."
'display the message - this line is required even if you then add the command to send the message
.Display
End With
DoEvents
Next i
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
lbl_Exit:
Exit Sub
End Sub