The code samples on this page create an appointment from an email message and adds it to a calendar. It's based off of the Convert email to task macro, but we needed the email added to a shared calendar to create a diary of sorts rather than as a Task.
Outlook 2013 and Outlook 2016's Quick Steps can be used to create an appointment but Quick Steps use the default reminder setting (and the default calendar).
This first macro works with open or selected Outlook items and creates a new appointment in a subfolder calendar named Log. The Outlook item is added as an attachment.
To use this macro, paste the code into a module and add a button to the ribbon or Quick Access Toolbar (QAT) in Outlook. The macro will work with either an open or selected item and you'll want to add a button to each item type you want to use it with.
To create an appointment from appointment details in the subject or message body, see "Create Appointment From Email Automatically".
Private Sub CreateLogCalendar()
Dim Ns As Outlook.NameSpace
Dim objApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim Item As Object ' works with any outlook item
Set Ns = Application.GetNamespace("MAPI")
Set objApp = Application
'On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set Item = objApp.ActiveExplorer.selection.Item(1)
Case "Inspector"
Set Item = objApp.ActiveInspector.CurrentItem
End Select
' Subfolder named 'Log' under calendar
Set calFolder = Ns.GetDefaultFolder(olFolderCalendar).Folders("Log")
Set olAppt = calFolder.Items.Add(olAppointmentItem)
With olAppt
.Subject = Item.Subject
.Attachments.Add Item
'.Body = Item.Body
.Start = Now
'.End = Now
.ReminderSet = False
.BusyStatus = olFree
.Save
.Display 'show to add notes
End With
Set objApp = Nothing
Set Ns = Nothing
End Sub
Save Message as Appointment
This code sample creates a new appointment on your default calendar and pastes the body of the selected message into the appointment's note's field.
It uses the Word object model; you'll need to set a reference to the Word Object Model in Tools, References.
Sub ConvertMessageToAppointment()
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Dim objInsp As Inspector
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Set objMail = Application.ActiveExplorer.Selection.Item(1)
If Not objMail Is Nothing Then
If objMail.Class = olMail Then
Set objInsp = objMail.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
With objSel
.WholeStory
.Copy
End With
End If
End If
End If
Set objAppt = Application.CreateItem(olAppointmentItem)
Set objInsp = objAppt.GetInspector
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Windows(1).Selection
With objAppt
.Subject = objMail.Subject
.Categories = "From Email"
objSel.PasteAndFormat (wdFormatOriginalFormatting)
'.Attachments.Add objMail
'.Save
.Display
End With
objMail.Categories = "Appt" & objMail.Categories
Set objAppt = Nothing
Set objMail = Nothing
End Sub
Create the appointment using rules
This macro uses a rule to create an appointment from incoming email. The rule should only contain conditions, not Actions. All actions need to be handled by the script. For more information, see Outlook's Rules and Alerts: Run a Script.
Because of limitations in appointments, any html in the message body won't be formatted.
The method used in other macros on this page to copy and paste formatted text wont work here, unless you have the macro open and close the incoming message. If you don't mind the quick flash onscreen as the macro opens and close the messages, I have a macro here that copies and pastes formatted text.
Public Sub ApptFromMail(Item As MailItem)
Dim objAppt As Outlook.AppointmentItem
Set objAppt = Application.CreateItem(olAppointmentItem)
With objAppt
.Subject = Item.Subject
.location = "Location"
.AllDayEvent = True
.BusyStatus = olBusy
.Start = Date + 3
.Body = Item.Body
.Display
.Save
End With
Set objAppt = Nothing
End Sub
Save the Appointment to a Shared Calendar
This version of the macro moves the resulting appointment to a Calendar in a shared mailbox or different data file.
To use this macro, you also need the GetFolderPath function from this page.
Select a message then run the macro to create an appointment in the designated calendar.
February 8 2015 updated code to work with a single selected message, not all messages in a selection.
Sub ConvertMailtoAccountAppt()
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objAppt = Application.CreateItem(olAppointmentItem)
Set CalFolder = GetFolderPath("mailbox-name\Calendar")
Set objMail = Application.ActiveExplorer.Selection.Item(1)
With objAppt
.Subject = objMail.Subject
'sets it for tomorrow at 9 AM
.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM#
.Body = objMail.Body
.Save
.Move CalFolder
End With
Set objAppt = Nothing
Set objMail = Nothing
End Sub
To create the appointment using the message's received time, use
objAppt.Start = objMail.ReceivedTime
Create a meeting with the recipients
This version of the code creates a new meeting with the sender and recipients of the message, with the CC'd recipients listed as optional attendees.
Yes, Outlook includes a command to create a meeting with the recipients of the current message, but everyone is placed in the Required field.
Sub ConvertMailtoMeeting()
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Dim objRecip As Outlook.Recipients
Dim myAttendee As Outlook.Recipient
Dim strAddress As String
Dim x As Long
Dim myCounter As Integer
'On Error Resume Next
Set objAppt = Application.CreateItem(olAppointmentItem)
objAppt.MeetingStatus = olMeeting
' Set CalFolder = GetFolderPath("alias@domain.com\Calendar")
Set objMail = Application.ActiveExplorer.Selection.Item(1)
Set objRecip = objMail.Recipients
Debug.Print objRecip.Count
myCounter = objRecip.Count
strAddress = objMail.SenderEmailAddress
Set myAttendee = objAppt.Recipients.Add(strAddress)
myAttendee.Type = olRequired
For x = 1 To myCounter
strAddress = objMail.Recipients(x).Address
Set myAttendee = objAppt.Recipients.Add(strAddress)
Select Case objMail.Recipients(x).Type
Case 1
myAttendee.Type = olRequired
Case 2
myAttendee.Type = olOptional
End Select
Next x
objAppt.Subject = objMail.Subject
'sets it for tomorrow at 9 AM
objAppt.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM#
objAppt.Body = objMail.Body
' objAppt.Save
'objAppt.Move CalFolder
objAppt.Display
Set objAppt = Nothing
Set objMail = Nothing
End Sub
Create an appointment for messages you send
This macro watches the Sent Items Folder for new items and creates an appointment in a subfolder of the default calendar.
Use an If statement as the first line of the olSent_ItemAdd macro to filter messages, such as create an appointment only if assigned to the category "Appt". (Note that unless you use Exchange server, categories are sent with messages.)
If Item.Categories <> "Appt" Then Exit Sub
Copy and paste the following code into ThisOutlookSession then restart Outlook.
You can use this code to watch the Inbox (change the Set olSent line to use olFolderInbox) and use an If statement to look for specific items. The incoming messages need to contain the appointment data in an uniform format. A code sample using a specially-crafted subject line and one using regex are available at
Dim WithEvents olSent As Items
Dim WithEvents calFolder As Outlook.Folder
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set olSent = NS.GetDefaultFolder(olFolderSentMail).Items
Set calFolder = NS.GetDefaultFolder(olFolderCalendar).Folders("Test")
Set NS = Nothing
End Sub
Private Sub olSent_ItemAdd(ByVal Item As Object)
Dim objAppt As Outlook.AppointmentItem
Set objAppt = calFolder.Items.Add(olAppointmentItem)
With objAppt
.Subject = Item.Subject
.Start = Now
.Body = Item.Body
.Save
End With
Set objAppt = Nothing
End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
Other macros to create tasks or appointments are at
Indy says
Hi,
you really helped me. Thank you!
I'm using the second makro and Outlook 2019 and there is a little problem with the line
I'm getting a runtime error 4605. Du you know any tweak?
Diane Poremsky says
I'll check it - I've had that error off and on - it usually works if I run I again. I'll test it again.
Tim says
Diane thank you for sharing, this is great. I am trying to use the "Save Message as Appointment" code but would like to add some functionality and can't seem to get it working.
1) take any attachments from the original email and add them to the calendar event. 2) define which calendar the event is added to
Diane Poremsky says
For attachments, you need to save the attachment and add to the appt. You need to use the CopyAttachments function and ad this line to your code.
CopyAttachments item, objAppt
This is the function -
Sub CopyAttachments(objSourceItem, objTargetItem)
'Cannot get this part to work (to copy attachments)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next
Set fldTemp = Nothing
Set fso = Nothing
End Sub
This sample shows how to set different folders - Create Tasks from Email and move to different Task folders (slipstick.com) It's easy to change it from task to appointments.
Hans says
HI,
I was looking for this for some time, it helped me really :-)
There one strange thing, when I open the appointment after saving it, the html email body shows fine, but on closing I get the question if I want to save the changes. I did not change anything so when I click no and reopen the appointment, the body content is gone. when I click yes to save the (not made) changes, all is there after reopening.
Can I do something to prevent the save changes question?
Thanks in advance,
Hans
Diane Poremsky says
are there links to external images or other content in the body? That can trigger it.
Hans says
Yes, it is an email comming from my site. It is made with a template containing the company logo.
Can anything be done to prevent it?
JJDD says
I really wanna make a script that when an email comes in with my seat number It will be added as an appointment on my calendar. So email comes through with seat D4 i want that to be put on my calendar ?
Diane Poremsky says
the 'Create the appointment using rules' macro should work - look for the seat # using the rule. It's also possible to use regex to find it, but rules would be better unless it finds a lot of false positives.
Dave says
How do I make an attachment to a calendar event before I
.save and .send
Diane Poremsky says
You need to use .attachments.add:
item.Attachments.Add "C:\Users\username\Documents\TEST.xlsx"
Dolf says
Hi
Is there a way to retrieve the start and end date from a mail's body that is always in a specific format?
objTask.StartDate = Item.ReceivedTime + 2
objTask.DueDate = Item.ReceivedTime + 3
objTask.Categories = "Slipstick"
Diane Poremsky says
Yes, you can either use instr & related functions or regex. The second macro at https://www.slipstick.com/developer/code-samples/create-appointment-email-automatically/ shows how.
Renaud says
Hi, when using the ConvertMailtoMeeting() function, is there a way to remove myself from the list of attendees, since I'm already the meeting organizer?
Thanks.
Diane Poremsky says
You'd check for your address as you add the recipients:
strAddress = objMail.Recipients(x).Address
if lcase(strAddress) = "me@domain.com" then
goto SkipAddress
end if
add this before the next:
SkipAddress:
Next x
tav says
Hello Diane, I upgraded to Office 2016 last Thursday (8/11/17) and now this macro (shared calendar event from a message) will not run. I'm not too sure about what level the Macro Settings should now be at as it's changed a bit. I tried them all but no luck. All the VB code is still there. Any ideas on how to resolve this? Thank you.
Diane Poremsky says
I know it works in 2016, i use this macro myself. Any error messages? If the apostrophe was removed from the beginning of the On Error Resume Next line, add it back - this will allow errors to stop the code and hopefully, give us an idea of what is wrong.
Did you sign the macro with a certificate created with selfcert? Some have said that causes an error - removing the signature and using the lowest setting is the current solution.
tav says
I had to redo the selfcert. That little video of yours helps very much.
But know I have a few selfcerts. How do I get rid of the 'older; ones? Thank you.
Diane Poremsky says
In either Internet Explorer or the Control panel, open Internet options then Content tab, Certificates button. Find and delete the certificate.
Mike says
Hello... I'm trying to save the objMail item to a new calendar appointment as an attachment rather than just text in the body of the message - any ideas?
Diane Poremsky says
Remove the copy and paste lines and use .attachments.add:
With objAppt
.Subject = objMail.Subject
.Attachments.Add objMail
.Display
End With
Diane Poremsky says
pcorun said
.Save
.Move CalFolder
.Display
Do I need to set something after the .Display??
No, and you don't need display if you are just moving and don't want to make any changes to it.
Chris says
Hello Diane, thanks for this article, was of great help. But i have another kind of issue with this. I am trying to display the appointments as a notice board for important announcements which will be on a big monitor without any peripherals connected to it. So it would be optimal to be able to see both the subject and body of the message without clicking the appointment. I cant put all the message in the subject. Do you know of anyway to achieve this ?
Diane Poremsky says
The best you can do in Outlook would be to use a view that shows preview - it won't show the entire body, but will show the first few words, depending on available space. (A 2 hour appt in day view using the 15 minute scale will show more of the body than using the hour scale.)
Another option is to strip unnecessary information from the message - remove html, images, etc so there is more room for text. Getting just the text is fairly easy, but its a little harder to remove the reply header or 'letterheads' at the top.
Chris says
Thanks for your reply, do you know of any open source software that perhaps would do a better job of this ?
Steve says
Hi Diane. Thanks for the work you do here, it's fabulous. I tried posting about this a few weeks ago, I either failed to hit the post button properly (that would be lame!) or you've been busy. Forgive me if you already have this in your queue.
I was trying to use your Create an appointment for messages you send code but when I reopen outlook after saving the code i get: "Compile error: Invalid attribute in Sub or Function" and "Dim WithEvents olSent" as Items is highlighted.
What am I missing?
Thanks again!
Diane Poremsky says
It was here, but i have been swamped the last month. Sorry.
Did you put the code in ThisOutlookSession?
Steve says
No, no - no apologies necessary, please don't work on mine until you're unswamped! Really, whenever you can get to it is fine.
Yes, in ThisOutlookSession along with two other subs of yours - Private Sub objSentItems_ItemAdd(ByVal Item As Object)
and
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _)
Diane Poremsky says
I can't repro the error - so try copying the code from the page again and replacing it it in ThisOutlookSession. Oh, what type of email account? i'm wondering if one of the folders isn't available when Outlook loads.
Steve says
Thanks Diane. I tried re pasting again - no luck. It's a microsoft exchange account. I can get the path to my local ost file if that's useful
Diane Poremsky says
if it is your mailbox and it's cached, it should be working. Is all of the text blue, green, or black color?
Is .items at the end of this line? That would cause the error as olSent is looking for items, not folder.
Set olSent = NS.GetDefaultFolder(olFolderSentMail).Items
Steve says
Yes, all text blue or black.
.items is at end of that line.
No error is received during execution and nothing happens.
Only when when I reopen outlook after saving the code i get: "Compile error: Invalid attribute in Sub or Function" and "Dim WithEvents olSent" as Items is highlighted.
How can I tell if my mailbox is cached?
Thanks again for digging in on this Diane, I seem to get only goofy problems.
Remember, no rush, only when you're unswamped!
Matt Sweet says
Firstly, thanks for the Macro - I have it working well.
Two questions:
1) Can I add more attendees?
2) Is there a way of altering the macro to cancel a meeting? If I have an email with subject of 'cancel app' and then use the same fields, can we do this? I'm using this as a way to get our intranet to sync with outlook (sync is a generous term here) in terms of meeting rooms.
Diane Poremsky says
this next/block does the recipients: For x = 1 To myCounter... Next x
if you need to add from another source, you'd use the same method to add other addresses. if the address will be added to all you can add it to the code:
Set myAttendee = objAppt.Recipients.Add("alias@address.com")
myAttendee.Type = olRequired
Matt Sweet says
Thanks Diane, I posted on the wrong page - I meant to post on the create a meeting automatically page.
I have worked out how to do multiple attendees on that macro, however I would like to know if it's possible to do a similar macro to cancel the meetings from an email with similar info.
Diane Poremsky says
you'd need to find and open the meeting then cancel - it should be possible but i don't have any sample code (and i'm out of town without access to my big computer).
Brian says
Hi,
This is very helpful, but I am still having trouble developing a macro, that will create an Appointment on my Calendar from an .ics Attachment. Is there a simple way for accomplishing this?
Thanks!
Diane Poremsky says
if it's an ics, you should just open it and click Save or Add to Calendar. If you want to automate the process with a macro, open it then save it should work. https://www.slipstick.com/outlook/email/save-open-attachment/ shows how to open an attachment - after it's open its an outlook item. Assign it to a object then use objectname.save
Alessandro says
Hi, thank you for your guide. I want just to send an appointment message and make that when outlook receives it, then it gives you the possibility to accept o refuse it and add it in your calendar if so. I tried this code:
Sub SendMeetingRequest()
Dim outMail As Object
Set outMail = Outlook.CreateItem(olAppointmentItem)
outMail.Subject = "A new appointment has been booked for me"
outMail.Location = "Nowhere"
outMail.MeetingStatus = olMeeting
outMail.Start = #2/8/2008# & " " & #9:15:00 AM#
outMail.End = #2/8/2008# & " " & #10:15:00 AM#
outMail.RequiredAttendees = "alias@domain.com"
outMail.Body = "No Reason"
outMail.Send
Set outMail = Nothing
End Sub
But it gives to me a error on .Send
I added outlook library. Thank you!
Diane Poremsky says
Sorry I missed this earlier and I'm sorry for spamming the address you include when i tested the macro. :( It works here in Outlook so I'm not sure what the problem is. If you are trying to send this from Word or Excel, you need to use CreateObject to create the outlook application.
Set olApp = Outlook.Application
If olApp Is Nothing Then
Set olApp = Outlook.Application
End If
(an excel macro sample is here https://www.slipstick.com/developer/create-appointments-spreadsheet-data/ )
pcorun says
Diane Poremsky said
.Body = objMail.Body
but since you are moving it, add .display after the move.
Here is the structure I used, but it was not successful:
.Save
.Move CalFolder
.Display
Do I need to set something after the .Display??
Diane Poremsky says
.Body = objMail.Body
but since you are moving it, add .display after the move.
kay says
Is there a macro for excel where, if i have the date, time, subject and location in a spreadsheet then the user can select the date or subject and it creates an outlook calendar event?
Diane Poremsky says
I have an Excel macro that creates appointments from all fields in a spreadsheet.
https://www.slipstick.com/developer/create-appointments-spreadsheet-data/#one
What you'd need to do is change it from looping all rows to using the selected row - use i = ActiveCell.Row to get the row then run the macro.
Patrick Corun says
Diane Poremsky said
Diane Poremsky submitted a new article on Slipstick.com
Create an Outlook appointment from an email message
Continue reading the Original Article at Slipstick.com
Click to expand...
Hello Diane, I am trying to work through a few issues with outlook 2013. My employer does not use an exchange server for emails and this makes it difficult to use some of the canned features within outlook. for example I can't create an appointment from an email, since my data file is for another account set up under outlook.com. So I tried the VBA code you recommended in this article and it works fine. Howver, I would like to know how I can have the appointment detail windo open up so that I can edit, modify or change things to the appointment. What would need to be added to the VBA code to make this happen and where would I need to add the code? I am not very good at VBA programming and would need some direction. Thanks in advance!! Here is the code.
Sub ConvertMailtoAccountAppt()
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objAppt = Application.CreateItem(olAppointmentItem)
Set CalFolder = GetFolderPath("mailbox-nameCalendar")
Set objMail = Application.ActiveExplorer.Selection.Item(1)
With objAppt
.Subject = objMail.Subject
'sets it for tomorrow at 9 AM
.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM#
.Body = objMail.Body
.Save
.Move CalFolder
End With
Set objAppt = Nothing
Set objMail = Nothing
End Sub
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
pcorun says
This was very helpful with my situation and taking an email and adding it to my calendar. However, I would like the macro to ope the event so I can midfy or add to it as needed. I have tried adding the ObjAppt.Display code right before the Set ObjAppt = Nothing, but it still does not open the event details window to edit it. Can you help with correcting the code to open the details window for editing??
Here is the code in my 'ThisOutlookSession'
Sub ConvertMailtoAccountAppt()Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objAppt = Application.CreateItem(olAppointmentItem)
Set CalFolder = GetFolderPath("mailbox-name\Calendar")
Set objMail = Application.ActiveExplorer.Selection.Item(1)
With objAppt
.Subject = objMail.Subject
'sets it for tomorrow at 9 AM
.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM#
.Body = objMail.Body
.Save
.Move CalFolder
End With
objAppt.Display
Set objAppt = Nothing
Set objMail = Nothing
End Sub`
Diane Poremsky says
The move is what messes it up - once it's moved, outlook can't find it. (Because it's not an automatic macro it can go in either thisoutlooksession or a module).
Remove the .move line and replace .display with this:
Dim moveCal As AppointmentItem
Set moveCal = objAppt.Move(CalFolder)
moveCal.Display
John says
Hi Diane,
With the latest Outlook Mac 2016 update, the AppleScript and Automator are not working for my create an appointment from message or task script. Do you have any suggestions or way to help me with a fix? Will they be including quick steps in the Mac verision?
Thank you,
John
Diane Poremsky says
I'll check on it - I thought the mac guys said it was an 'oops' but I'm not 100% sure.
On quick steps, I don't think so, but I'll double check.
John says
Hi Diane,
This is very helpful. Thank you. Could you help me in setting up short-cut keys for the apple script in Outlook Mac 2016. I can't figure it out. I'm using an old script from 2011: Create an appointment from a message and Create a task from a message. Again, thank you for your help. I really appreciate it.
John
Dawson says
Hello Diane Poremsky,
I am looking for a outlook addin that will monitor all my incoming emails in my inbox folder and auto create a calendar appointment. I need to addin to be activated if the subject line contains specific words like "new appointment" I want the addin to get the appointment information from the subject of the email message. such as appt name: appt location: appt date: appt time. all this has to be done automatically
Diane Poremsky says
I'm not sure if Auto-mate can do it, but as long as there are a limited number of keywords to check and the format for the appt details is always the same, you can use an itemadd macro.
Diane Poremsky says
I finally got around to doing a macro that can do this. It's at https://www.slipstick.com/developer/code-samples/create-appointment-email-automatically/ - there are two versions. One uses appointment details in the subject line, the second uses appointment details in the message body.
Lane says
Oh! Will this work on a shared folder?
Diane Poremsky says
You can make it watch a shared inbox by changing this line:
Set olInbox = NS.GetDefaultFolder(olFolderInbox).Items
and add to a shared calendar but changing this Set objAppt = Application.CreateItem(olAppointmentItem) to
Set objAppt = folderobject.Items.Add(olAppointmentItem) where folderobject is set
Brian Davis says
Okay, now i'm stumped again. I've got the macro to convert the sent messages to an appointment in my calendar. But now i would like to change the subject line of the resulting appointment to say something like "Email to xxxx@xxxxx.com " + the original subject line of the email.
if there were multiple recipients, it would only need to be the first recipient in the email.
any other email recipients could be inserted into the body of the appointment
so the body might be
email to
xxxx@xxxxx.com
yyyy@yyyy.com
zzzz@zzzz.com
and then insert the body of the original email.
Diane Poremsky says
You need to get the recipients and then grab the first for the subject. (assuming you are using item to identify the mail object - change it as needed)
.subject = "Email to " & item.Recipients(1) & " " & item.subject
This will get you a list of all recipients - then use .body = strRecip & vbcrlf & item.body
Dim strRecip As String
For Each Recipient In objMail.Recipients
strRecip = strRecip & vbcrlf & Recipient.Address
Next Recipient
brian davis says
what if i want the body of the appointment to be not just the body of the email, but i want to include the name of the person that i sent the email to? I tried
.Body = Item.Recipients
but that didn't work
Diane Poremsky says
Name of the sender would be item.sendername, address is item.senderemailaddress
brian davis says
Also, do i understand this correctly that where the command has "Set calFolder = NS.GetDefaultFolder(olFolderCalendar).Folders("Test") " that it is using a calendar folder named "Test" ? So if my calendar is named Work Diary i should put that in between the quotes in place of Test?
brian davis says
yes. that was right.
brian davis says
I"m getting an error message with the first withevents - says compile error - invalid attribute in sub or function. then it highlights the phrase "WithEvents olSent As Items"
brian davis says
oh oh oh !!! i figured it out !!!! I had to move the DIM withevents to the top of the thisoutlooksession module. it worked!!!!!
brian davis says
ugh, why is this so difficult? I need a macro that will convert every email that I send to an appointment. I would like the email body copied into the appointment body, and then add the email as an attachment to the appointment. I want the start time of the appointment to be the time sent of the email. last, i want the appointment saved to a specific calendar (not the default calendar).
Diane Poremsky says
If you want *every* message turned into an appointment, use an item add macro that watches the sent folder. The second macro at https://www.slipstick.com/developer/recipient-email-address-sent-items/ is an itemadd watching the sent folder - put it together with the macro on this page.
Diane Poremsky says
I'll add a an itemadd macro to this page.
Nikhil says
Thanks Diane,
It worked perfectly. You are amazingly helpful.
I am also looking for a macro which can create an appointment (not a meeting with other participants) and retains the email as an attachment. I know there is a Quick Step feature in Outlook, but I want to use it differently.
Thanks in advance.
Diane Poremsky says
When you create the appointment, add .attachment add objMail before the save (replacing objMail with the object name you are using for the message)
Nikhil says
Hi Diane,
Thanks for sharing the code. Is there a way we can amend it so that the original email gets copied as an attachment?
Diane Poremsky says
Sure, just add .Attachments.Add objMail before the .save
Nikhil says
Hi Diane,
I tried using the code to create a meeting from the mail. It seems only recipients from the original mail are added as invitees in the meeting, and not the sender. Is there a way I can (i) add sender along with the recipients; (ii) Create an invite only to the sender of the original email?
Thanks in advance.
Diane Poremsky says
I updated the code on the page so it is definitely working now, getting the sender. Case 1 and Case 2 are looking at the to and cc field, not the recipients count - definitely glad i decided to take a closer look at it tonight.
Alex says
Thank you for all of your help. you are a rock star!!!
Alex says
when I right click on the calendar the calendar property box appears. in the box it says "Calendar" underneath that it says:
type: folder containing calendar items under that
location "\\outlook data file"
When posting to this folder, use: IPM.Appointment
Diane Poremsky says
If the data file is "outlook data file", you'll use
Set CalFolder = GetFolderPath("outlook data file\Calendar")
Alex says
thank you for all of your help? how do find the name of the calendar, and where is it located?
Diane Poremsky says
How many calendars are in your Outlook profile? The one in your default data file is the default calendar - you don't need a path for it. For calendars in other data files, you'll use the data file display name (what you see in the folder pane) and you'll put the path in this:
Set CalFolder = GetFolderPath("mailbox-name\Calendar")
Alex says
Should it look like this? What is next? where do I save things to?
Sub ConvertMailtoAccountAppt()
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objAppt = Application.CreateItem(olAppointmentItem)
Set CalFolder = GetFolderPath("mailbox-name\Calendar")
Set objMail = Application.ActiveExplorer.Selection.Item(1)
With objAppt
.Subject = objMail.Subject
'sets it for tomorrow at 9 AM
.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM#
.Body = objMail.Body
.Save
.Move CalFolder
End With
Set objAppt = Nothing
Set objMail = Nothing
End Sub
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Diane Poremsky says
What calendar folder do you want to save it in?
This sets the folder:
Set CalFolder = GetFolderPath("mailbox-name\Calendar")
If you want to use your default calendar folder you don't need to name a folder and would remove the line that moves the calendar: .Move CalFolder
Alex says
I am not understanding how to implement this "you also need the GetFolderPath function from this page." When I click on the link there is more code. where do I insert? how do I insert?
Diane Poremsky says
You nneed ot get the function in the lower middle of the article (it's name is Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder) and paste it either in a new module or at the end of the macro, after the end sub, not in the middle of the macro.
John Kelley says
I receive automatically generated emails at work whenever I schedule a specific piece of equipment in the form:
From: jim.jibbers@work.com
To: me.myself@work.com
Subject: Scheduled Equipment Use - Work Order Number: 12345
Body:
Work Order Number: 38401
Jibbers, Jim
Building: 123 Room: 567
Phone: 555-9876
has reserved Instrument 1
Scheduled Appointment:
Date: 06/23/2015
Time: 04:00 PM
I would like a macro + rule combo to automatically generated Outlook appointments from these emails when they arrive using the following setup:
Subject: Training - user from Line 2 (i.e. Jim Jibbers)
Location: whatever is after "has reserved" (i.e. Instrument 1)
Date: date from Line 8
Start Time: time from Line 9
End Time: 2 hours later
Attendees: sender of automatically generated email (i.e. jim.jibbers@work.com)
Category: MCF
I would appreciate any suggestions offered!
Cathy Gilham says
Hi Diane,
As per Mark's comment above I am looking for a way to set the start and end time of the meeting based on information contained within the email.
You noted this could be done using a macro - I'm a relative n00b to VB. Can you be a bit more explicit?
Thanks
CJG
Diane Poremsky says
You needs to use regex to read the message and look for the time - it works best if the time is identified as the start time or is the only thing in the message in a date and time format.
A sample macro that grabs data is here - https://www.slipstick.com/developer/regex-parse-message-text/
Jenny says
I'm so glad to find this. I've managed to get it to work as an alert.
However, it doesn't get applied to the new incoming email the rule is set for, but an older email already in the inbox. I think it's because the script runs first and then the new email shows up in the inbox. What can I do to change this?
Public Sub NewMeeting(Item As Outlook.MailItem)
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objAppt = Application.CreateItem(olAppointmentItem)
For Each objMail In Application.ActiveExplorer.Selection
objAppt.Subject = objMail.Subject
objAppt.Start = objMail.ReceivedTime + TimeValue("00:16")
objAppt.Body = objMail.Body
objAppt.Save
Next
Set objAppt = Nothing
Set objMail = Nothing
End Sub
Diane Poremsky says
This line: For Each objMail In Application.ActiveExplorer.Selection tells it to create an appointment for each message in the selection. Delete that line and Next (the word), along with Dim objmail line then change objMail to Item (or item to objMail) and it should work in a rule.
Public Sub NewMeeting(Item As Outlook.MailItem)
Dim objAppt As Outlook.AppointmentItem
Set objAppt = Application.CreateItem(olAppointmentItem)
with objappt
.Subject = Item.Subject
.Start = Item.ReceivedTime + TimeValue("00:16")
.Body = Item.Body
.Save
End with
Set objAppt = Nothing
End Sub
Tim D. says
Thank you very much for your quick reply, for clearing up my fundamental misunderstanding, and finally for the script to call it either way!
Tim D. says
I'm having very much the same issue as Liz. However when I change the script to pub ConvertMailtoMeeting() it still doesn't show any scripts in the "run script" box. If I change the script to pub ConvertMailtoMeeting(item as outlook.mailitem) I can't even run it from within VBA.
I feel like I am missing some fundamental step, but can't imagine what it might be.
Diane Poremsky says
ConvertMailtoMeeting() = macro you can run from vba.
ConvertMailtoMeeting(item as outlook.mailitem) = script for a run a script rule or that is run from another macro.
If you want to use it either way, you can use a small macro to call the same macro that the rule runs
Sub ConvertMailManual()
Dim objmail As Outlook.MailItem
Set objmail = Application.ActiveExplorer.Selection.Item(1)
ConvertMailtoMeeting objmail
End Sub
Sub ConvertMailtoMeeting(objmail As MailItem)
' the rest of the macro -
' delete Set objMail = Application.ActiveExplorer.Selection.Item(1)
Liz P says
s
My script works great when I run with VBA; however, when I go to Outlook, I can't see any scripts showing when I try to "run script" from the rules. Any ideas why it would do that?
Diane Poremsky says
That means its not set up for use with rules. It needs to be something like pub macroname(item as outlook.mailitem)
See this article for more information:
https://www.slipstick.com/outlook/rules/outlooks-rules-and-alerts-run-a-script/
which macro did you want to use in a rule?
Mark says
Hi Diane,
Is it possible to create an appointment from an email message and set the start time as indicated in the email subject or body?
Thanks! :)
Diane Poremsky says
Yes, but only if you use a macro to create it.
KB MacKenzie says
Perfect! Thank you so much for your speedy response.
KB MacKenzie says
Hi, Diane! Thanks for the timely post. I was in the process of adapting the create task automation to appointment when you posted this. I modified the code as follows because the client indicated she would prefer a prompt to input the date and time for the appointment. And, for the most part it works. Except that once tied to a rule, which processes on arrival it creates the appointment for whichever message is selected in the user's inbox, instead of the new message which triggered the rule and called the script.
Sub MakeApptFromEmail(item As Outlook.MailItem)
Dim objAppt As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Dim ApptDate, ApptTime, myStart As Date
ApptDate = Format(Date, "m/d/yyyy")
ApptTime = Format(Time, "hh:mm AMPM")
myStart = Format(Date, "m/d/yyyy hh:mm AMPM")
Set objAppt = Application.CreateItem(olAppointmentItem)
ApptDate = InputBox("Enter date for appointment formatted as 1/15/2000", "Enter Appointment Date", Date)
ApptTime = InputBox("Enter start time for appointment formatted as 9:00 AM", "Enter Appointment Time", "9:00 AM")
myStart = ApptDate + " " + ApptTime
' MsgBox ApptDate
' MsgBox ApptTime
' MsgBox myStart
For Each objMail In Application.ActiveWindow
objAppt.Subject = objMail.Subject
objAppt.Start = myStart
objAppt.ReminderSet = True
objAppt.Body = objMail.Body
objAppt.Save
'objAppt.Move CalFolder
Next
Set objAppt = Nothing
Set objMail = Nothing
End Sub
We run in cached mode if that makes a difference. Any idea?
Diane Poremsky says
I think the inputbox delays it, so the message that triggered it is no longer the item. If so, should work if you use entryid's.
Or this line: For Each objMail In Application.ActiveWindow is the problem. If you are using a rule to trigger it, you don't need to check multiple messages. Replace that line with Set objmail line below.
Dim strID As String
strID = Item.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
Sanjiv Talwar says
Diane
thanks for the tip. I was wondering if your code could be changed to add all the email addresses to be invitees for the appointment notice created.
Another build to this above requirement could be to have email addresses in the To field as Required invitees and those in the cc field as optional.
Diane Poremsky says
Outlook has a Meeting button that will create a meeting with recipients/sender on an email. It won't put CC in the optional field though. But yes, you can do it with code.
This is messy - and the cc addresses are not optional (should be, probably a stupid mistake in the code) but it creates the appt and addresses it.
Update - it was a stupid mistake. I forgot to set the meeting status. :( I'll put the updated code in the article.