Outlook VBA: Using Word Inspector to create a Follow Up Meeting Invite - vba

I am creating a VBA Macro in Outlook that will copy an existing meeting invite and create a follow up meeting invite. It should be fairly easy since I have all the parts to this puzzle.
My problem is with the body of the invite; all formatting and pictures are lost. For this reason, I need to use the Word Inspector object to preserve any special formatting and images. I figured out the code using Word and recording a macro.
So I have figured out the code for copying text using the Word Inspector, but I am not sure on how to paste it in another invite.
Sub copyPaste()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
On Error Resume Next
Set objOL = Application
If objOL.ActiveInspector.EditorType = olEditorWord Then
Set objDoc = objOL.ActiveInspector.WordEditor
Set objNS = objOL.Session
Set objSel = objDoc.Windows(1).Selection
objSel.WholeStory
objSel.Copy
objSel.PasteAndFormat (wdFormatOriginalFormatting)
End If
Set objOL = Nothing
Set objNS = Nothing
End Sub
Please see my current Outlook code:
Sub scheduleFollowUpMeeting()
'Declarations
Dim obj As Object
Dim Sel As Outlook.Selection
'Selecting the Email
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set obj = Application.ActiveInspector.currentItem
Else
Set Sel = Application.ActiveExplorer.Selection
If Sel.Count Then
Set obj = Sel(1)
End If
End If
If Not obj Is Nothing Then
MsgBox "The original meeting has been copied." & vbCrLf & "Please kindly update any new details like date/time.", , "Follow Up Meeting - Amit P Shah"
Dim objFollowUp As Outlook.AppointmentItem
Set objFollowUp = Application.CreateItem(olAppointmentItem)
'Copies existing details from original Invite
With objFollowUp
.MeetingStatus = olMeeting
.Subject = "Follow Up: " & obj.Subject
.Body = obj.Body
.Start = Now + 1 'Takes today's date and adds 1 day
.End = DateAdd("n", obj.Duration, .Start)
'Other
.AllDayEvent = obj.AllDayEvent
.BusyStatus = obj.BusyStatus
.Categories = obj.Categories
.Companies = obj.Companies
.ForceUpdateToAllAttendees = obj.ForceUpdateToAllAttendees
.Importance = obj.Importance
.Location = obj.Location
.OptionalAttendees = obj.OptionalAttendees
.ReminderMinutesBeforeStart = obj.ReminderMinutesBeforeStart
.ReminderOverrideDefault = obj.ReminderOverrideDefault
.ReminderPlaySound = obj.ReminderPlaySound
.ReminderSet = obj.ReminderSet
.ReminderSoundFile = obj.ReminderSoundFile
.ReplyTime = obj.ReplyTime
.RequiredAttendees = obj.RequiredAttendees
.Resources = obj.Resources
.ResponseRequested = obj.ResponseRequested
.Sensitivity = obj.Sensitivity
.UnRead = obj.UnRead
.Display
End With
End If
End Sub
Any help would greatly be appreciated. Many thanks in advance!

I'm not a specialist on this subject but i used to work and manipulate Outlook's AppointmentItem in C# and that's how i see the thing.
Actually, if you try to copy the body of a meeting on another meeting, like you said, you will lose all the special formating, images, etc.
The new body will only contain the caracters without format.
I think you can't put formatted text on the body property, you have to use the rtfbody property or like you did when you copy the body of your original appointment, use the WordEditor property in the Inspector object.
So, try to use the WordEditor of the new Item you're creating (like you did to take the original content) and to add content in it.
That's what i had to do for putting formatted text in the body of an AppointmentItem in C#.
I did something like that :
Word.Document myDoc = myItem.GetInspector.WordEditor;
Word.Paragraphs paragraphs = myDoc.Content.Paragraphs;
Word.Paragraph para = paragraphs.Add();
para.Range.Text = yourFormattedTextHere;
After that, you may need to release the variables created, but i'm not sure about that.

Related

I want to add "CC" and Text in the body of this code. What should I do to add it?

I have been able to create an automated email reply as I wanted. However, I wanted to add text in the body of the email and cc to add email address. How should I add it?
Sub FwdSelToAddr()
Dim objOL As Outlook.Application
Dim objItem As Object
Dim objFwd As Outlook.MailItem
Dim strAddr As String
Dim objRecip As Outlook.Recipient
Dim objReply As MailItem
On Error Resume Next
Set objOL = Application
Set objItem = objOL.ActiveExplorer.Selection(1)
If Not objItem Is Nothing Then
strAddr = ParseTextLinePair(objItem.Body, "Email:")
If strAddr <> "" Then
Set objFwd = objItem.Forward
objFwd.To = strAddr
objFwd.Display
Else
MsgBox "Could not extract address from message."
End If
End If
Set objOL = Nothing
Set objItem = Nothing
Set objFwd = Nothing
End Sub
This is what I have done so far. I just want to be able to add CC email address and text in the body in the automated reply.
You need to modify the code a bit by setting the Cc property and the HTMLBody one if you need to modify or update the message body:
If strAddr <> "" Then
Set objFwd = objItem.Forward
objFwd.To = strAddr
objFwd.Cc = "email#address.com"
objFwd.HTMLBody = "<b>Hello world</b>"
objFwd.Display
Else
Be aware, to preserve the message body from the original email you need to insert your content between the opening <body> and closing </body> tags. If you need to add in the beginning of the message paste your additional text right after the opening tag, if you intend to paste it in the end of message - paste right before the closing tag.
Also you may find the Recipients property of the MailItem class helpful. It allows a more convenient way for setting up recipients for the Outlook items. You can read more about that property in the article that I wrote for the technical blog - How To: Fill TO,CC and BCC fields in Outlook programmatically.

VBA - How to insert Horizontal Line in Outlook TaskItem

I want to insert an horizontal line, eg., before a text in a TaskItem body. It is possible to do this using Insert menu and clicking the horizontal line button on symbols group. But, how to code this?
This is what I've tried:
Sub NewTask()
Dim objTask As Outlook.TaskItem
Set objTask = Application.CreateItem(olTaskItem)
With objTask
.Subject = "Example Task"
.Body = ??What to put in here?? & "Example Body"
.Save
End With
Set objTask = Nothing
End Sub
This post show how to reach this for Mails. As far as I know, MailItem have Html body property whereas TaskItem does not have.
Thanks in advance.
Instead, you need to use the TaskItem.RTFBody property which returns or sets a byte array that represents the body of the Microsoft Outlook item in Rich Text Format.
The code for a horizontal line is the following:
\pard \brdrb \brdrs\brdrw10\brsp20 {\fs4\~}\par \pard
To set up the RTF formatting in Outlook you may use the following code:
.BodyFormat = olFormatRichText
.Body = StrConv("your RTF string", vbFromUnicode) 'Convert RTF string to byte array
Be aware, The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
I was not able to reach the solution through RTFBody. However the Word object model approach, pointed by Eugene Astafiev, helped me to solve the issue.
First of all: Add reference to Word library in VBA Editor, Tools, References
And this is the example sub working:
Sub NewTask()
Dim objTask As Outlook.TaskItem
Dim objInsp As Inspector
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Set objTask = Application.CreateItem(olTaskItem)
Set objInsp = objTask.GetInspector
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Windows(1).Selection
With objTask
.Subject = "Example Task"
objSel.InsertAfter "Example Body"
objDoc.InlineShapes.AddHorizontalLineStandard
.Display
.Save
End With
Set objTask = Nothing
Set objInsp = Nothing
Set objDoc = Nothing
Set objSel = Nothing
End Sub

Outlook Macro to get recipients of an appointment

I am trying to get all the recipients "list of people in TO: .. section" of an outlook appointment that I select.
I need the subject and and the recipients of all the selected appointments, I could get the subject but am not able to get the recipients. Below is the code I tried..
Sub testCode()
Dim objItem As Object
Dim objApp As Outlook.Application
Set objApp = Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.workbooks.Open "C:\data.xlsm"
For i = 1 To 49
Set objItem = objApp.ActiveExplorer.Selection.Item(i)
xlApp.Range("A" & i & "").Value = objItem.Subject
xlApp.Range("B" & i & "").Value = objItem.To // not working
Next i
End Sub
There is no To field in an appointment. There are required attendees and optional attendees.
Use these properties:
objItem.OptionalAttendees
and
objItem.RequiredAttendees
As a sidenote, the easiest way to figure out things like this is to examine the object in the locals window of the code window while stepping through the code. This way you can see all of the properties that the object has and figure out what to use.
Use the AppointmentItem.Recipients collection and loop through all recipients. Recipient.Type = olTo are required, olCC - optional, olBCC - resources.

Open Drafts (or selected emails) add BCC, subject, and send

My VBA experience is incredibly limited.I have created basic macros for excel primarily by frankensteining multiple macros I find online together.
Here's what I am looking to do. Every morning I send out an email to a list of 200 customers, I open the new message from a list and the message auto populates (as it is a signature). Currently I then go through all these emails and add my subject and BCC. Could I possibly create a macro to open all of these emails, add my BCC, add my subject, and then send the emails.
Any and all help is much appreciated.
The following code defines an instance of Outlook.Application, and sets up a MailItem ready for sending. It uses a Dictionary object called EmailData to hold the various bits of info to populate To, BCC etc but those can be replaced with your own strings etc. I've pulled this from a function I wrote and made it a little more generic:
Public Function OL_SendMail()
Dim bOpenedOutlook, sComputer, iLoop, iAccount, sAttachArray, sAttachment
bOpenedOutlook = False
sComputer = "."
Dim oWMIService : Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Dim colItems : Set colItems = oWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'outlook.exe'")
Dim oOutlook : Set oOutlook = CreateObject("Outlook.Application")
Dim oNamespace : Set oNamespace = oOutlook.GetNamespace("MAPI")
If colItems.Count = 0 Then
' Outlook isn't open, logging onto it...
oNamespace.Logon "Outlook",,False,True
bOpenedOutlook = True
End If
Dim oFolder : Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
If EmailData("SendFrom") = "" Then
' default to first email account the user has access to
iAccount = 1
Else
' Checking to see if the account to send from is accessible by this user...
iAccount = 0
For iLoop = 1 To oOutlook.Session.Accounts.Count
If UCase(Trim(oOutlook.Session.Accounts.Item(iLoop))) = UCase(Trim(EmailData("SendFrom"))) Then
iAccount = iLoop
Exit For
End If
Next
If iAccount = 0 Then
sErrorMsg = "Cannot send email from specified account: " & EmailData("SendFrom") & " as this user doesn't appear to have access to it in Outlook!"
OL_SendMail = False
Exit Function
End If
End If
Dim oMailItem : Set oMailItem = oOutlook.CreateItem(olMailItem)
With oMailItem
Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
.To = EmailData("To")
.CC = EmailData("CC")
.BCC = EmailData("BCC")
.Subject = EmailData("Subject")
.Body = EmailData("Body")
sAttachArray = Split(EmailData("AttachmentPaths"), ";")
For Each sAttachment In sAttachArray
.Attachments.Add(sAttachment)
Next
.Recipients.ResolveAll
.Display ' debug mode - uncomment this to see email before it's sent out
End With
'Mail Item created and ready to send
'oMailItem.Send ' this is commented out so the mail doesn't auto send, allows checking of it!!
Set oMailItem = Nothing
Set oNamespace = Nothing
If bOpenedOutlook Then
'oOutlook.Quit
End If
Set oOutlook = Nothing
Set colItems = Nothing
Set oWMIService = Nothing
OL_SendMail = True
End Function

How to add an embedded image to an HTML message in Outlook 2010

I have Office 2003 VBA code that uses the technique described here to embed an image in an HTML message using undocumented MAPI properties and CDO 1.21.
CDO 1.21 is no longer supported, but according to MSDN, most of its functionality is now incorporated into the Outlook 2010 object model.
Where can I find a sample that embeds images in an Outlook 2010 message using the Outlook 2010 object model?
Found the answer here.
The key bits being:
Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
...
Set colAttach = l_Msg.Attachments
For x = 1 To Items.Count
Set l_Attach = colAttach.Add(Items.Item(x))
Set oPA = l_Attach.PropertyAccessor
oPA.SetProperty PR_ATTACH_MIME_TAG, ItemTypes.Item(x)
oPA.SetProperty PR_ATTACH_CONTENT_ID, "item" & x
oPA.SetProperty PR_ATTACHMENT_HIDDEN, True
Next
Here other example:
Option Explicit
'Add reference to MS Outlook x.x Object Library
'Picture to be added as an attachment and modified src location for each embedded picture.
Private Sub Command1_Click()
Dim oApp As Outlook.Application
Dim oEmail As MailItem
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.Attachment
'create new Outlook MailItem
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
'add graphic as attachment to Outlook message
'change path to graphic as needed
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add("D:\my documents\[color=red]MyPic.jpg[/color]")
oEmail.Close olSave
'change the src property to 'cid:your picture filename'
'it will be changed to the correct cid when its sent.
oEmail.HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
"<IMG alt='' hspace=0 src='[color=red]cid:MyPic.jpg[/color]' align=baseline border=0> </BODY>"
oEmail.Save
oEmail.Display 'fill in the To, Subject, and Send. Or program it in.
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub
you can find it on:
http://www.vbforums.com/showthread.php?278600-VB-Embedd-an-image-into-an-Outlook-email-message-body
This is a vb code snippet by Dmitry Streblechenko (MVP). It worked fine for me.
Set objOutlook = CreateObject("Outlook.Application")
Set Ns = objOutlook.GetNamespace("MAPI")
Ns.Logon
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookRecip = objOutlookMsg.Recipients.Add("test#dimastr.com")
objOutlookRecip.Type = olTo
objOutlookMsg.Subject = "test"
' add graphic as attachment to Outlook message
Set colAttach = objOutlookMsg.Attachments
Set l_Attach = colAttach.Add("z:\Temp\8\1.jpg ")
l_Attach.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x370E001F", "image/jpeg" '
Change From 0x370eE001E
l_Attach.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "myident"
'Changed from 0x3712001E
objOutlookMsg.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8514000B", True
'
Set body format to HTML
objOutlookMsg.BodyFormat = olFormatHTML
objOutlookMsg.HTMLBody = "html tags goes here< img align="
baseline " order="
1 " hspace="
0 " src="
cid: myident " width="
" 600="
" > </img> end html tags"
objOutlookMsg.Save
objOutlookMsg.Send
Here is the method I've found works the best for me. I used to just link to the subfolder but found some international users experienced huge lag and even crashed there inbox. I switched to the below so that the image was imbedded in the email and it solved the lag issues because the file is actually embedded in the email.
Sub sendKeyMailer()
Dim emlMsg As Object
Set emlMsg = CreateObject("CDO.Message")
strBody = "<html> yadda yadda tricks are for kids. <br><br>"
strBody = strBody & "<img src=""cid:myimage.jpg""><BR><BR>"
strBody = strBody & "but tricks make the world go round.</html>"
emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<<yourserver>>"
emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
emlMsg.Configuration.Fields.Update
emlMsg.AddRelatedBodyPart "C:\temp\The Big Eskimo Roll.jpg", "myimage.jpg", cdoRefTypeId
emlMsg.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.jpg>"
emlMsg.Fields.Update
With emlMsg
.To = "allthepeople#yourcompany.com"
.From = "aGrpLst#yourcompany.com"
.Subject = "Humpty dumpty had a great fall" '''I have kids....;^D.....
.HTMLbody = strBody
'.AddAttachment "C:\temp\The Big Eskimo Roll.jpg"
.Send
End With
Set emlMsg = Nothing
End Sub