Outlook Check, Import Template, Add To Template and Send

[DataBlake]

Hey i'm having trouble getting an outlook code to work in my favor.
Basically i have a userform that an end user fills out and it assigns 2 strings to errorHD and issueHD

I want to check if the user already has outlook open
If its not then open outlook
Then use a template that looks like

Name & Date:
<p> TEXT TO BE INSERTED BY EXCEL
<p>
<p>
Issue:
<p> TEXT TO BE INSERTED BY EXCEL
<p>
<p>
Error Codes:
<p> TEXT TO BE INSERTED BY EXCEL
<p>
<p>

Name & Date would be automatically generated using Application.Username and Now()
issueHD would be inserted under "Issue:"
errorHD would be inserted under "Error Codes:"

and this email would be automatically sent to me
i have a template made already "C:\dest\HelpDesk.oft"

just unsure of how to insert the text into it / what the best methods are to use here.
any help would be appreciated

 

[DataBlake]

using these very useful guides i have the check and open outlook complete
https://www.rondebruin.nl/win/s1/outlook/mail.htm

the only thing i'm missing is how to format the body of my email.
is there a way to format a string in VBA?
I.E have the text, spacing, color, font, and size of the string be formatted specific ways?

#Const LateBind = True

Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  LateBind Then

Public Function OutlookApp( _
    Optional WindowState As Long = olMinimized, _
    Optional ReleaseIt As Boolean = False _
    ) As Object
    Static o As Object
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Public Function OutlookApp( _
    Optional WindowState As Outlook.OlWindowState = olMinimized, _
    Optional ReleaseIt As Boolean _
) As Outlook.Application
    Static o As Outlook.Application
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
On Error GoTo ErrHandler
 
    Select Case True
        Case o Is Nothing, Len(o.Name) = 0
            Set o = GetObject(, "Outlook.Application")
            If o.Explorers.Count = 0 Then
InitOutlook:
                'Open inbox to prevent errors with security prompts
                o.Session.GetDefaultFolder(olFolderInbox).Display
                o.ActiveExplorer.WindowState = WindowState
            End If
        Case ReleaseIt
            Set o = Nothing
    End Select
    Set OutlookApp = o
 
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case -2147352567
            'User cancelled setup, silently exit
            Set o = Nothing
        Case 429, 462
            Set o = GetOutlookApp()
            If o Is Nothing Then
                Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
            Else
                Resume InitOutlook
            End If
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
    End Select
    Resume ExitProc
    Resume
End Function

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  LateBind Then
Private Function GetOutlookApp() As Object
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Function GetOutlookApp() As Outlook.Application
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
On Error GoTo ErrHandler
    
    Set GetOutlookApp = CreateObject("Outlook.Application")
    
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case Else
            'Do not raise any errors
            Set GetOutlookApp = Nothing
    End Select
    Resume ExitProc
    Resume
End Function

Sub Mail_small_Text_Outlook()
'For Tips see: [url]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/url]
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = OutlookApp()
    Set OutMail = OutApp.CreateItem(0)

    strbody = _

    

    On Error Resume Next
    With OutMail
        .To = "EMAIL
        .CC = ""
        .BCC = ""
        .Subject = "HelpDesk Ticket " & Application.UserName & " " & Today()
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[shknbk2]

The easiest way I know of (and have used) is to create a new email with the message/formatting, etc. how you want it. Then, in Outlook's VBE, type the following into the Immediate window:

?Activeinspector.CurrentItem.htmlbody

I copy the resulting text into something else (Notepad) to view it better and then know the text I'm starting with and what needs to go in for the various HTML codes. Create/format the string of strbody based on the html coding and then you would change .HTMLBody rather than .Body in your code.

 

[DataBlake]

coding and then you would change .HTMLBody rather than .Body in your code.

thank you!
after using .HTMLBody my final result is a module which contains

#Const LateBind = True

Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  LateBind Then

Public Function OutlookApp( _
    Optional WindowState As Long = olMinimized, _
    Optional ReleaseIt As Boolean = False _
    ) As Object
    Static o As Object
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
Public Function OutlookApp( _
    Optional WindowState As Outlook.OlWindowState = olMinimized, _
    Optional ReleaseIt As Boolean _
) As Outlook.Application
    Static o As Outlook.Application
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
On Error GoTo ErrHandler
 
    Select Case True
        Case o Is Nothing, Len(o.Name) = 0
            Set o = GetObject(, "Outlook.Application")
            If o.Explorers.count = 0 Then
InitOutlook:
                'Open inbox to prevent errors with security prompts
                o.Session.GetDefaultFolder(olFolderInbox).Display
                o.ActiveExplorer.WindowState = WindowState
            End If
        Case ReleaseIt
            Set o = Nothing
    End Select
    Set OutlookApp = o
 
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case -2147352567
            'User cancelled setup, silently exit
            Set o = Nothing
        Case 429, 462
            Set o = GetOutlookApp()
            If o Is Nothing Then
                Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
            Else
                Resume InitOutlook
            End If
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
    End Select
    Resume ExitProc
    Resume
End Function

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  LateBind Then
Private Function GetOutlookApp() As Object
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
Private Function GetOutlookApp() As Outlook.Application
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
On Error GoTo ErrHandler
    
    Set GetOutlookApp = CreateObject("Outlook.Application")
    
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case Else
            'Do not raise any errors
            Set GetOutlookApp = Nothing
    End Select
    Resume ExitProc
    Resume
End Function

and then putting this in my userform module with issueHD and errorHD being publicly declared strings
i will have to mess with the html until i like it, but for now it will do

Sub mailTIME()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = OutlookApp()
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "EMAIL"
        .CC = ""
        .BCC = ""
        .Subject = "HelpDesk Ticket " & Application.UserName & " " & Now(mm.dd.yy)
        .htmlbody = 'SEE BELOW       
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

and this as the .HTML code

"HelpDesk Ticket " & Application.UserName & " " & Format(Date, "MM-DD-YYYY")
        .htmlbody = "<h2><strong>Name and Date:</strong></h2><p>" & Application.UserName & " " & Format(Date, "MM-DD-YYYY") & _
                     "<p><p><h2><strong>Issue:</strong></h2><p>" & issueHD & _
                     "<p><p><h2><strong>Error Codes:</strong></h2><p>" & errorHD

thank you for your help!

 

[shknbk2]

You are welcome.