Adding Default Email Signature via Macro written email in Outlook

Question

I am trying to write a macro in outlook that when I click the "new mail" button, it prompts for an attachment. When I select the attachment, it will then read the name of it, and place that name in the subject and the body.

Currently I am able to preform the above tasks, with some minor issues, that I was hoping I could get some help with. As of right now, when I am prompted for an attachment, I select it, but then it requires me to do it a second time. It will then only use that second attachment for the information and actually attaching to the email. My second issue is that I can't figure out how to get the email to add the default signature on the end when it writes the macro.

I have never worked with VBA before Friday, and very little coding experience, so I'm hoping someone can help. I copied some of the code from elsewhere, then built upon it, so I know it may be jumbled and not the cleanest code.

Sub CreateNewMail()
Dim obApp As Object
Dim NewMail As MailItem
Dim otherObject As Word.Application
Dim fd As Office.FileDialog
Dim fileaddress As String
Dim filename As String
Dim signature As String

Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)


'Set to use Word for Attach File Dialog
Set otherObject = New Word.Application
otherObject.Visible = False

Set fd = otherObject.Application.FileDialog(msoFileDialogFilePicker)

With fd
.AllowMultiSelect = False
.InitialFileName = "\\atro1\users\tdomanski\scan"
.Show
End With

fd.Show

fileaddress = fd.SelectedItems(1)

'Aquire File Name in correct form for Subject Line
Dim MidStart As Long
MidStart = InStrRev(fileaddress, "\") + 1

Dim MidEnd As Long
MidEnd = InStrRev(fileaddress, ".")

filename = Mid(fileaddress, MidStart, MidEnd - MidStart)



htmlbody1 = "<HTML><Body><p>Good Afternoon,</p><p>Please confirm receipt of attached "
htmlbody2 = "<br/>Please either email an order acknowledgement to me or initial & fax back PO to 716-655-0309.<p>Also, we are striving for 100% on-time delivery of purchase orders.  If you cannot meet the required delivery date on the PO, please contact me as soon as possible.</p><p>Thank you!</p></body></html>"

'You can change the concrete info as per your needs
With NewMail
     .Subject = filename
     .BodyFormat = olFormatHTML
     .HTMLBody = (htmlbody1 + filename + htmlbody2)
     .Attachments.Add ((fileaddress))
     .Display
End With
signature = oMail.HTMLBody
Set obApp = Nothing
Set NewMail = Nothing

End Sub

See this answer for how to add the signature. After you've created NewMail, Outlook populates the signature if you NewMail.Display. — BigBen

1001001 1001001 · Accepted Answer · 2018-05-15T13:18:32

Adding the default signature to the mail is a bit tricky. Once I wanted to do this but couldn't find easy solution. So I came up with a detour way to achieve this. What the first procedure does is creating and saving an mail in draft folder. There is no Body in this mail so it somehow add a default signature if exists.

Public Sub SendAnEmail()
Dim Poczta As New Outlook.Application
Dim mojMail As MailItem
Dim Subj As String

Subj = "Test"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "[email protected]"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        '.Body = sign
        .Display
        '.Send
        .Save

    End With

End Sub

Then in for each loop we read the mails from draft and connecting strings. First string is an Body mail which in this moment suppose to be your signature and you can concatened this with anything you want.

Sub Drafts()

Dim DraftFold As Outlook.Folder
Dim item As MailItem
Dim sign As String

Set DraftFold = 
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

For Each item In DraftFold.Items
    sign = item.Body
Next item

Dim Poczta As New Outlook.Application
Dim mojMail As MailItem

Dim Subj As String
Dim Text As String


Subj = "Test"

Text = "Anything"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "[email protected]"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        .Body = sign
        .Display
        '.Send

    End With

End Sub

Well I know that it is not a great solution but if you won't find any better try to work with this.

Adding Default Email Signature via Macro written email in Outlook

1 Answers