Change VBA script to send HTML email instead of text

[StarEagle]

I have used a VBA macro for years to forward emails to a fixed email address that was my task manager web based software. It worked but it forwarded a text email whether the original email was text or HTML. This was ok because that task manager did not like HTML emails. I have switched to a different task manager that does accept HTML emails which is great except my macro only forwards text emails.

I need help in modifying my macro to send emails as they are, text or HTML. I have tried some HTML VBA commands, but all I did was create a mess. Any assistance would be appreciated including hints as to what to try, including commands. The current macro is:

Sub TDFwd2()
Dim helpdeskaddress As String
Dim objMail As Outlook.MailItem
Dim strbody As String
Dim oldmsg As String
Dim emailSubject As String
Dim senderaddress As String
Dim emailTo As String
Dim addresstype As Integer
' Set this variable as your helpdesk e-mail address
helpdeskaddress = "dummy@fake.com"
Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
' Sender E=mail Address
senderaddress = objItem.SenderEmailAddress
'Searches for @ in the email address to determine if it is an exchange user
addresstype = InStr(senderaddress, "@")
' If the address is an Exchange DN use the Senders Name
If addresstype = 0 Then
senderaddress = objItem.SenderName
End If
emailTo = objItem.To
emailSubject = objItem.subject
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "Sent by: " & senderaddress & vbNewLine & "To: " & emailTo & vbNewLine & "Subject: " & emailSubject & vbNewLine & vbNewLine & objItem.Body
objMail.To = helpdeskaddress
objMail.subject = objItem.subject
objMail.Body = strbody
' remove the comment from below to display the message before sending
'objMail.Display
'Automatically Send the ticket
objMail.Send
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function

 

[StarEagle]

I figured it out with a bit of experimentation.

 

[Diane Poremsky]

Are you using an if statement to see if the original is plaintext or html and using either
objMail.Body = strbody
or
objMail.HTMLBody = strbody

 

[JARROD]

Decent, need to accomplish something like this with mine.