Outlook Macro New Message Loses Formatting - vba

I am writing an outlook sub procedure that takes the currently selected email, parses it, and creates a new email message. The parsing is simple enough: Extract the email addresses from the first line of the message and then the rest of the body is the regular email body in the new message.
I am using this basic code for setting the body of the new message:
Set newMsg = Outlook.Application.CreateItem(olMailItem)
With newMsg
.BodyFormat = olFormatHTML
.Body = newBody
'... set subject,etc
.Display
The problem is that the new message that is created loses all of the HTML formatting that the message I was copying the information from possessed ( and various font stylings). I tried setting the new message's body format to HTML (see code above), but that did not do the trick. Currently, the new message contains all of the textual data, but instead of the table, each cell's data is tab-delimited and the entire message body is in the same font.

BodyFormat does not behave as expected. Instead, HTMLBody can be used as below to properly display the body in HTML format:
With newMsg
.HTMLBody = newBody
'... set subject,etc
.Display

Related

Forward Outlook email without adding signature nor From: and To: of original email

I'm looking to forward email that I receive in Outlook to a new address with no changes - an exact clone, no envelope information nor signature added.
The email will always have an HTML table in the body and needs to be preserved identically. I can get it to forward but it always adds a blank email body with a signature "above" the original email, and then there is the standard From: and To: and email attributes above the original email.
Is there a way to remove this? I have tried to change this to generate a "new" object, as the new object is not bringing in the HTML body before forwarding.
Sub Send_Forward(ByRef oMail As Object, repBodyStr As String, sendMail As
Boolean)
Dim myForward As Object
Set myForward = oMail.Forward
myForward.Subject = myForward.Subject
myForward.HTMLBody = repBodyStr & "<br>" & myForward.HTMLBody
myForward.Recipients.Add "xxx#xxx.net"
myForward.Display
ExitSub:
Set myForward = Nothing
End Sub
Create a new item (Application.CreateItem), then just copy the HTMLBody property from the existing message and add the recipients.
UPDATE: if you need to copy the attachments (such as images), you would have to save the attachments from the original message (Attachment.SaveAsFile), then add them as attachments to the new message (MailItem.Attachments.Add). Note that this will not work with embedded OLE objects (in case of the RTF format) and embedded message attachments. For the images, you would also need to copy the PR_ATTACH_CONTENT_ID MAPI property using Attachment.PropertyAccessor.
Also note MailItem.Copy would not work as the message sent state will be copied (which his not what you want).
If using Redemption (I am its author) is an option, it allows to make a copy of the message without copying its sent state. Something like the following should do the job (off the top of my head):
Set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set originalMsg = Session.GetRDOObjectFromOutlookObject(Application.ActiveExplorer.Selection(1))
set newMsg = Session.GetDefaultFolder(olFolderDrafts).Items.Add
'copy the message and clear out recipients
originalMsg.CopyTo(newMsg)
newMsg.Recipients.Clear
newMsg.Recipients.Add "xxx#xxx.net"
newMsg.Save
'now reopen the message in OOM and diplay it. Or you can use newMsg.Display
set myForward = Application.Session.GetItemFromID(newMsg.EntryID)
myForward.Display

Find and Replace specific string in Outlook message

My code basically searches for the string "#XX" in the email body. The "#XX" is usually followed by a text like "#XXApple". And this "#XXApple" can be seen multiple times in the email message.
The code below works in such a way that it only replaces the first hit with spaces. However, the rest of the "#XXApple" will only be changed to "Apple"
Is there a way where I can do a "Find and Replace All" in Outlook?
obj.HTMLBody = Replace(obj.HTMLBody, "#XX", " ", 15)
Not tested or verified but this is the general idea of what I meant to say in the comment above.
Dim Cet
Dim TesPos As Int, i As Int
Cet = Split(obj.HTMLBody, " ")
For i=LBound(Cet) to Ubound(Cet)
TestPos = 5
TestPos = InStr(1,Cet(i), "#XX", CompareMethod.Text)
if TestPos = 1 then
Cet(i) = ""
Else: End if
Next i
obj.HTMLBody = ""
For i=LBound(Cet) to Ubound(Cet)
obj.HTMLBody = obj.HTMLBody & " " & Cet(i)
Next i
Debug.Print obj.HTMLBody
The Outlook object model provides three main ways for working with item bodies:
Body - a string representing the clear-text body of the Outlook item.
HTMLBody - a string representing the HTML body of the specified item.
Word editor - the Microsoft Word Document Object Model of the message being displayed. The WordEditor property of the Inspector class returns an instance of the Document class from the Word object model which you can use to set up the message body.
You can read more about all these ways in the Chapter 17: Working with Item Bodies. It us up to you which way is to choose to deal with the message body. But the Word object model provides all the required methods to get the job done.

Embedding InfoPath form in email with VBA using SMTP/CDO

I am attempting to do the following:
Use VBA to generate SMTP email
Display InfoPath form embedded in email
This will be linked to an Access database
Unfortunately, I have not been able to configure the outgoing SMTP message correctly using CDO.
I have been building on information found in this post which unfortunately is in C# and some of this functionality doesn't directly map to VB/VBA. Specifically, the "Message.Headers" part is not a property the CDO.Message class has.
I have been able to change the attachments and add them correctly but while the following works:
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
the form is not displayed in the email (both the xml and xsn are appearing as attachments and NOT displaying as an embedded form).
In comparing email source between a valid form (generated manually) and invalid (generated proramatically) I have not been able to determine what else I must change. There are several more content tags in the emails, one is:
Content-Type: text/html; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable
<html dir=3D"ltr" id=3D"L044F61201A9E6BE2"> <head> <meta http-equiv=3D"Content-Type" content=3D"text/html; charset=3Diso-8859-= 1"> </head>
(etc, there is a bunch more)
and another is:
Content-Type: text/plain; charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
And under this there is text from the actual form.
Presumably these sections need to be generated automatically by some setting I am not using correctly.
Here is the code I am using to generate my emails. Note that the two attachments are valid and ones I saved off a form which does display correctly, when I use InfoPath to send the email.
Sub testSendingEmail()
On Error GoTo errHndlr 'boring error handling
Dim myAttach(1 To 2) As String
Dim myContentType(1 To 2) As String
myAttach(1) = "C:\Users\UserID\Desktop\infoPath\outlooksaves\Form1.xml"
myAttach(2) = "C:\Users\UserID\Desktop\infoPath\outlooksaves\Add Projects Table Form.xsn"
myContentType(1) = "application/x-microsoft-InfoPathForm"
myContentType(2) = "application/x-microsoft-InfoPathFormTemplate"
Dim mailMessage As Object
Set mailMessage = CreateObject("CDO.Message")
With mailMessage
.Subject = "Test Automatic Subject 363"
.from = "donotreply#a.com"
.To = "TestEmail#gmail.com"
.AddAttachment myAttach(1)
.AddAttachment myAttach(2)
.Attachments.Item(1).ContentMediaType = myContentType(1)
.Attachments.Item(2).ContentMediaType = myContentType(2)
'testing - this isn't right :(
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
With .Configuration.fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailserve"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'.Item("http://schemas.microsoft.com/cdo/configuration/mailheader:Content-Class") = "InfoPathForm.InfoPath"
.Update
End With
'.BodyPart.ContentClass = "InfoPathForm.InfoPath"
'from C# code
'.Headers.Add "Content-Class", "InfoPathForm.InfoPath"
' .Headers.Add "Message-Class", "IPM.InfoPathForm.InfoPath"
.Send
End With
Exit Sub
errHndlr:
Debug.Print "Error!" & " " & Err.Description
End Sub
I was able to get this working with one extra line. You need to add .fields.update after you add the headers.
This will not show the form in the preview unfortunately, but it will attach it as proper infopath form.
'testing - this isn't right :(
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
.fields.update 'Need to update the header fields

Outlook custom forms - Edit message on send event

I've modified an outlook message form to include a custom dropdownlist. I need to append the selected value from the dropdownlist onto the beginning and end of the message text when the user sends. How do I do this?
Example: User selects "Priority 1" from ddl and sends message "Here is a message." I would want the recipient to see "Priority 1 Here is a message. Priority 1" Thanks!
How are you sending the message throught the send function of the form you used or are you sending the form throught code i would recomend sending the form throught code this is because you have greater control over the features of the message being sent.
Combining this with the outlook and system variables you can return a fair amount of relevant and usful data.
Set DropBox = objPage.Controls("DropBoxName")
With oOMail
.To = "mail#adressee.com.au"
.Subject = DropBox.Text && "Subject"
.Body = "message" && DropBox.Text && vbCrLf
.Send
End With

How to convert the body of an email into a .pdf

I have to convert an email into .pdf without the head which includes the information about the date, the receivers, cc, etc.
Does anyone how to do that the easy way?
My other solution would be to copy the whole body of the mail into a new word-document and save it as a .pdf, but I don't know how to copy the whole body via VBA either.
[EDIT JMax from comments]
Here is the code I've tried:
sBody = oMail.HTMLBody
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
wrdApp.Documents.Add "C:\asd\Releasemail.dotx"
wrdApp.Documents("Dokument1").Bookmarks().Item("Releaseinhalt").Range.Text = sBody
I get my whole HTML printed in the .doc, but I want the body of the mail as it's shown in Outlook, not the markup, that creates that look. For example, if I press Ctrl + a and Ctrl + c in Outlook and press Ctrl + v in Word, I get the text with all its styling copied to Word.
How to do that in VBA?
When you want to get only the body of a mail, you have to use this kind of statement:
Dim Msg As Outlook.MailItem
Body = Msg.HTMLBody
You can find another example on this blog and on VBA Express
Have a try and come back when you will have an issue on some code.
[EDIT]
To get the body content instead of HTML, you can use : Msg.Body but you will then probably loose the formatting of the message.