Outlook 2019 Macro to send an Email Template from User Defined Contact Form

Witzker

Senior Member
Outlook version
Outlook 2019 64-bit
Email Account
POP3
Hi,
I have put together this macro
That sends an email template to the email address 1 inserts contact name and formats the title from an opened user defined contact form and put some text at the end of the form body in green:

Code:
Sub TestPlate() 'MAKRONAME eingeben
   Dim textInFormular, VorlagenPfad, VorlageDateiname, VorlagenDatei, Nachricht, Adresse As String, Text, Format As String: Set item = ActiveInspector.CurrentItem
    
    'Text der ins Formular geschrieben wird
'===================================================================================================== -> Function addTextToBody
    addTextToBody "VERSCHICKT: TEXT Testplate" '<-HIER DEN Text in "TEXT..." eingeben der ins Formular geschrieben wird
'=====================================================================================================
    
    'Name der Vorlagen DATEI xxxx.oft
'=====================================================================================================
    VorlageDateiname = "TESTplate.oft" 'HIER DEN VORLAGEN NAMEN EINGEBEN am besten aus Explorer den Namen kopieren!
'=====================================================================================================
    
    VorlagenPfad = "C:\Users\Public\- Cloud\- Outlook Vorlagen\" 'Pfad zum Vorlagen Ordner = FIX
    VorlagenDatei = VorlagenPfad & VorlageDateiname
    CreateEmail objMailItem, VorlagenDatei, item ' Function CreateEmail(objMailItem, VorlagenDatei, item) -> Create email and set recipient, categories, importance level
    objMailItem.HTMLBody = GetRecipientName(item) + objMailItem.HTMLBody ' Function GetRecipientName(item) As String
    objMailItem.Display
End Sub
Function addTextToBody(textInFormular As String)
    Dim objItem As Object
    Set objItem = Outlook.Application.ActiveInspector.CurrentItem
    Dim objWordDoc As Word.Document
    Set objWordDoc = objItem.GetInspector.WordEditor
    Dim objWordApp As Word.Application
    Set objWordApp = objWordDoc.Application
    objWordApp.Selection.EndKey wdStory, wdMove
    objWordApp.Selection.TypeText Text:=vbCrLf
    objWordApp.Selection.Font.Color = RGB(0, 0, 255)
    objWordApp.Selection.TypeText Text:=Format(Now, "dd.mm.yyyy hh:nn") & " " & textInFormular
    objWordApp.Selection.TypeParagraph
    objWordApp.Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    objWordApp.Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    objWordApp.Selection.Font.Reset
End Function
Function CreateEmail(objMailItem, VorlagenDatei, item)
    Dim objMailOLApp As Object
    Set objMailOLApp = GetObject(, "Outlook.Application")
    Set objMailItem = objMailOLApp.CreateItemFromTemplate(VorlagenDatei)
    With objMailItem
        .To = item.Email1Address  'Empfänger der Mail aus Kontakt lesen
        .Categories = "Geschäftlich"
        .Importance = olImportanceNormal
        .BodyFormat = olFormatHTML
    End With
End Function
Function GetRecipientName(item) As String
    If item.Title = "" Then
        GetRecipientName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte Damen und Herren" & "," & "</FONT></BODY></HTML>"
    ElseIf InStr(1, item.Title, "Herr") > 0 Then
        GetRecipientName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrter" + " " + item.Title + " " + item.LastName + "," & "</FONT></BODY></HTML>"
    ElseIf InStr(1, item.Title, "Frau") > 0 Then
        GetRecipientName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte" + " " + item.Title + " " + item.LastName + "," & "</FONT></BODY></HTML>"
    Else
        GetRecipientName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte(r)" + " " + item.Title + " " + item.LastName + "," & "</FONT></BODY></HTML>"
    End If
End Function

Do you have some improvements to the code?
 
Similar threads
Thread starter Title Forum Replies Date
H send reminder if no reply received on first or original email using macro Using Outlook 2
K Macro Not Executing then send email from Explorer Outlook VBA and Custom Forms 3
C Macro to send email after changing from address and adding signature Outlook VBA and Custom Forms 1
T Using a macro to send email to diffrent address Outlook VBA and Custom Forms 1
M Use a macro to send files by email Outlook VBA and Custom Forms 3
E macro to send an email when an EMAIL reminder fires Using Outlook 1
Geldner Send / Receive a particular group via macro or single keypress Using Outlook 1
E Outlook - Macro - send list of Tasks which are not finished Outlook VBA and Custom Forms 3
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
O using macro to send attachments Using Outlook 3
B Looking for Outlook 2013 update for Send Drafts Macro Using Outlook 4
Q Outlook Macro to do a send/receive on specific group Outlook VBA and Custom Forms 1
Witzker Outlook 2019 Macro to check Cursor & Focus position Outlook VBA and Custom Forms 8
V Macro to mark email with a Category Outlook VBA and Custom Forms 4
M Outlook 2019 Macro not working Outlook VBA and Custom Forms 0
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
D Auto Remove [EXTERNAL] from subject - Issue with Macro Using Outlook 17
V Macro to count flagged messages? Using Outlook 2
sophievldn Looking for a macro that moves completed items from subfolders to other subfolder Outlook VBA and Custom Forms 7
S Outlook Macro for [Date][Subject] Using Outlook 1
E Macro to block senders domain Outlook VBA and Custom Forms 1
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
N VBA Macro To Save Emails Outlook VBA and Custom Forms 1
N Line to move origEmail to subfolder within a reply macro Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to answer a mail with attachments Outlook VBA and Custom Forms 2
A Outlook 2016 Macro to Reply, ReplyAll, or Forward(but with composing new email) Outlook VBA and Custom Forms 0
J Macro to Insert a Calendar Outlook VBA and Custom Forms 8
W Macro to Filter Based on Latest Email Outlook VBA and Custom Forms 6
T Macro to move reply and original message to folder Outlook VBA and Custom Forms 6
D Autosort macro for items in a view Outlook VBA and Custom Forms 2
S HTML to Plain Text Macro - Help Outlook VBA and Custom Forms 1
A Macro to file emails into subfolder based on subject line Outlook VBA and Custom Forms 1
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
S Visual indicator of a certain property or to show a macro toggle Outlook VBA and Custom Forms 2
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
S Macro to extract and modify links from emails Outlook VBA and Custom Forms 3
M Replyall macro with template and auto insert receptens Outlook VBA and Custom Forms 1
L Macro to add Date & Time etc to "drag to save" e-mails Outlook VBA and Custom Forms 17
S Macro for Loop through outlook unread emails Outlook VBA and Custom Forms 2
Globalforester ItemAdd Macro - multiple emails Outlook VBA and Custom Forms 3
S Macro to extract email addresses of recipients in current drafted email and put into clipboard Outlook VBA and Custom Forms 2
Witzker HowTo start a macro with an Button in OL contact form Outlook VBA and Custom Forms 12
Witzker Macro to move @domain.xx of a Spammail to Blacklist in Outlook 2019 Outlook VBA and Custom Forms 7
S Macro for other actions - Outlook 2007 Outlook VBA and Custom Forms 23
C Macro to extract sender name & subject line of incoming emails to single txt file Outlook VBA and Custom Forms 3
L Macro/VBA to Reply All, with the original attachments Outlook VBA and Custom Forms 2
S Macro to move “Re:” & “FWD:” email recieved the shared inbox to a subfolder in outlook Outlook VBA and Custom Forms 0
S Outlook Macro to move reply mail based on the key word in the subjectline Outlook VBA and Custom Forms 0
Eike Move mails via macro triggered by the click of a button? Outlook VBA and Custom Forms 0

Similar threads

Top