Outlook 2019 HELP to get Template Path in a Function

Post number 3 has been selected as the best answer.

Witzker

Senior Member
Outlook version
Outlook 2019 64-bit
Email Account
POP3
Hi, troubles to get the template path into a function
I have a Macro that should send an email template to the already opened contact Fill in Email and name open it for editing and send it

without the new function, it worx like this:

Code:
Sub TESTplate_0() 'Makro name wichtig zum aufrufen Der Name des Makros muss der Syntax von Makronamen entsprechen, es wird dann auch so in dropdown angezeigt
                           'Betreff und eventuelle Anlagen werden in der Vorlage definiert und sind dann mit der Vorlage gespeichert
'Variablen dimm
    Dim textInFormular
    Dim VorlagenPfad
    Dim VorlageDateiname
    Dim VorlagenDatei
    Dim Nachricht
    Dim Adresse As String
    Dim Text
    Dim Format As String
    Set item = ActiveInspector.CurrentItem

    'Text der in Kontaktformular geschrieben wird in die variable eingegeben und an die Funktion addTextToBody übergeben
   
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 addTextToBody "VERSCHICKT: TEXT " '<---------
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

    'Pfad zur Vorlage Eingeben !! ist bei uns auf allen Rechnern gleich, sonst anpassen
    VorlagenPfad = "C:\Users\Public\- Cloud\- Outlook Vorlagen\" '--> Vorlage Dateinamen Eingeben !! am besten Namen mit .oft von Vorlage aus explorer kopieren
   
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 VorlageDateiname = "TESTplate.oft" '<---------
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
       
    VorlagenDatei = VorlagenPfad & VorlageDateiname
    Dim objMailItem As Object
    Dim objMailOLApp As Object
    Set objMailOLApp = GetObject(, "Outlook.Application")
    Set objMailItem = objMailOLApp.CreateItemFromTemplate(VorlagenDatei)
    '---Empfänger Email aus Kontakt lesen ----------------------------------------------------------------------------
    With objMailItem
        .To = item.Email1Address  'Empfänger der Mail aus Kontakt lesen
        .Categories = "Geschäftlich"
        .Importance = olImportanceNormal
        .BodyFormat = olFormatHTML
     End With
    '---Empfänger Anrede und Namen aus Konakt lesen und einfügen ----------------------------------------------------
    Adresse = ReadName()
    objMailItem.HTMLBody = Adresse + objMailItem.HTMLBody
    objMailItem.Display
End Sub

needed functions working:
Code:
Function ReadName() As String
    Dim item As Object
    Set item = ActiveInspector.CurrentItem
    If item.title = "" Then
        ReadName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte Damen und Herren" & "," & "</FONT></BODY></HTML>"
    ElseIf InStr(1, item.title, "Herr") > 0 Then
        ReadName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrter" + " " + item.title + " " + item.lastName + "," & "</FONT></BODY></HTML>"
    ElseIf InStr(1, item.title, "Frau") > 0 Then
        ReadName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte" + " " + item.title + " " + item.lastName + "," & "</FONT></BODY></HTML>"
    Else
        ReadName = "<HTML><BODY><FONT size=2 face=" & "'" & "Arial" & "'" & ">" & _
                "Sehr geehrte(r)" + " " + item.title + " " + item.lastName + "," & "</FONT></BODY></HTML>"
    End If
End Function
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:mm") & ": "
    objWordApp.Selection.TypeText Text:=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
so far so gud

now I want to replace as much as possible in an additional function that the macro is as small as possible, and I can copy it and use it to send other template emails.

Here is the edited macro with the added function that does not work:
Code:
Sub TESTplate_1()
    'Variablen dimm
    Dim textInFormular
    Dim VorlagenPfad As String
    Dim VorlageDateiname As String
    Dim Nachricht
    Dim Adresse As String
    Dim Text
    Dim Format As String
    Set item = ActiveInspector.CurrentItem
   
    'Text der in Kontaktformular geschrieben wird in die variable eingegeben und an die Funktion addTextToBody übergeben
    addTextToBody "VERSCHICKT: TEXT " '<---------
   
    'Pfad zur Vorlage Eingeben !! ist bei uns auf allen Rechnern gleich, sonst anpassen
    VorlagenPfad = "C:\Users\Public\Cloud\Outlook Vorlagen"
    'Vorlage Dateinamen Eingeben !! am besten Namen mit .oft von Vorlage aus explorer kopieren
    VorlageDateiname = "TESTplate.oft"
   
    Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
VorlagenDatei = fso.BuildPath(VorlagenPfad, VorlageDateiname)
   
   
    Dim objMailItem As Object
    Set objMailItem = CreateEmailFromTemplate(VorlagenPfad, VorlageDateiname)
   
    'Empfänger Anrede und Namen aus Konakt lesen und einfügen
    Adresse = ReadName()
    objMailItem.HTMLBody = Adresse + objMailItem.HTMLBody
    objMailItem.Display
End Sub

Function CreateEmailFromTemplate(VorlagenPfad As String, VorlageDateiname As String) As Object
    Dim objMailItem As Object
    Dim objMailOLApp As Object
    Dim VorlagenDatei As String

    VorlagenDatei = VorlagenPfad & "\" & VorlageDateiname
    'Debug.Print VorlagenDatei
    MsgBox VorlagenDatei
    Set objMailOLApp = GetObject(, "Outlook.Application")
    Set objMailItem = objMailOLApp.CreateItemFromTemplate(VorlagenDatei)
    With objMailItem
        .To = item.Email1Address
        .Categories = "Geschäftlich"
        .Importance = olImportanceNormal
        .BodyFormat = olFormatHTML
    End With
    Set CreateEmailFromTemplate = objMailItem
End Function

when I call the macro, I get:
the path is correct
1674351761217.png


BUT THAN
1674351841977.png

1674351873207.png


The template must be accessible because it worx with the first macro above.
Hope everything is clear?!
PLS. Help to get this working.
Many THX
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
>>
Runtime error '-2147287037 (80030003)':
The file 'C:\Users\Public Cloud\Outlook Templates\TESTplate.oft' cannot be opened. The file may already be open, or you do not have permission to open the file.
<<

The error indicates the template is found but cannot be opened. If you copy the path and try opening t from exploter, what happens?

What is in the template? If it has certain controls, it need to be in the default templates location.
 

Witzker

Senior Member
Outlook version
Outlook 2019 64-bit
Email Account
POP3
THX for taking care

It is solved in this macro:
 
Similar threads
Thread starter Title Forum Replies Date
G Message template / custom forms and VBA Help needed - inserting info into table Outlook VBA and Custom Forms 3
A outlook printing assistant Help editing template Using Outlook 3
R HELP!!! Email template with active excel spreadsheet Using Outlook 1
M XML help with modded template Using Outlook 0
Christopher M Outlook 365 HELP! Calendar Craziness! Using Outlook 5
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
e_a_g_l_e_p_i Has nobody used Office 2021 enough to help me or have you given up on me.......lol Using Outlook 1
X Open Hyperlinks in an Outlook Email Message (Help with Diane's solution) Outlook VBA and Custom Forms 3
L Help connecting to hosted exchange server 2016 Using Outlook 0
B Seeking help with Outlook rule Using Outlook 2
D Need help with MS Authenticator Using Outlook 4
I Outlook for Mac 2019 using on desktop and laptop IMAP on both need help with folders Using Outlook 1
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
S.Champ Please help? I've imported a random workcalendar I dont even know who's. Can I undo it? and then I need to re-sync the google one again. Its a mess:( Using Outlook 2
S HTML to Plain Text Macro - Help Outlook VBA and Custom Forms 1
e_a_g_l_e_p_i Outlook 2010 Help setting up Gmail account in Outlook 2010 Using Outlook 3
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
Y Filter unread emails in a search folder vba help Outlook VBA and Custom Forms 0
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
F Microsoft Outlook Connector 14.0.6123.5001 - Help! Using Outlook 6
Witzker Pls help to change the code for inserting date in Ol contact body Outlook VBA and Custom Forms 5
R Disable conversation thread from replying of recipients in the same subject. Please help Using Outlook 0
R seperate read layout to design in outlook 2016..Help!! Outlook VBA and Custom Forms 3
O Help .. got lost ... installing Office like 2016 Using Outlook 5
A Arthur needs help with 2007 Outlook e-mail Using Outlook.com accounts in Outlook 3
R Help Revising VBA macro to delete email over different time span Outlook VBA and Custom Forms 0
Marc2019 Need help please! Cannot Setup my outlook email account on my Mac Outlook 2011 Using Outlook.com accounts in Outlook 2
L Attachment saving and tracking - PLEASE help! Outlook VBA and Custom Forms 5
I Help with dates in task list. Using Outlook 5
C need help setting up outlook first time Using Outlook 1
K To do bar help Using Outlook 8
M Help sending email but removing signature via VBA Outlook VBA and Custom Forms 5
S help with outlook scripting Outlook VBA and Custom Forms 4
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
EmelineGueguen Help to understand the problem of work Using Outlook 1
N Outlook Forms Help Outlook VBA and Custom Forms 2
N Need help syncing contacts to iPhone X Using Outlook 8
S VBA Macro - Run-time error '424': object required - Help Please Outlook VBA and Custom Forms 3
broadbander Needing help with reply/reply all while keeping attachments and adding a new CC recipient. Outlook VBA and Custom Forms 5
J Help! My contacts have disappeared. Using Outlook 5
J HELP- Rule to auto strip prepend from external emails Using Outlook 0
J Help Needed With Multi-Step Login Email Address Using Outlook.com accounts in Outlook 1
G Bcc help - Preventing multiple forwards from a bcc'd distribution group Using Outlook 1
G [Help] Converting array to destination folder path Outlook VBA and Custom Forms 1
K Help.... Office Outlook 2016 Using Outlook 1
S Error using AddressEntry.GetContact - need help Outlook VBA and Custom Forms 2
D Help with code to move mail on receipt to another folder based on time received Outlook VBA and Custom Forms 2
E Outlook 2010 need help with rules Using Outlook 0
B HELP! Using Outlook 4
Jeff Davis Help fix my Outlook 2013? Using Outlook 28

Similar threads

Top