This article brings to conclusion the Outlook VBA macro\/script I wrote to process event scheduling attachments (.ICS or ICalendar files). The first article shows how to process emails and remove their associated attachments. The second shows how to open the files and both read the file contents into an array as well as write (append) to the file. This code works in Outlook 2007.<\/p>\n
The script does the following:<\/p>\n
1. Check if the email has an attachment
\n2. If the attachment is an ICalendar (.ICS) file, remove it to a common folder and update the email with a link to the detached file.
\n3. Loop through the ICS files in the designated folder and load them into an array.
\n4. If the last element in the array contains the value “PROCESSED”, skip it
\n5. Take the UID (Unique IDentifier) array element and turn it into an Outlook Event GUID.
\n6. Check if there are any events which have the UID Guid. If there are, this indicates the new file is an update to a previously processed event.
\n7. If there is no previous event with the UID Guid, add the event using the UID Guid as an identifier.
\n8. If there is a previous event and the new notice is a cancellation, delete the event.
\n9. If there is a previous event and the new notice is not a cancellation, update the event.
\n10. Append a line to the ICS file with the value “PROCESSED”.<\/p>\n
Public Sub SaveICSAttachmentsMacro()\r\n Dim objOL As Outlook.Application\r\n Dim objitem As Outlook.MailItem 'Object\r\n Dim objAttachments As Outlook.Attachments\r\n Dim objSelection As Outlook.Selection\r\n Dim i As Long\r\n Dim lngCount As Long\r\n Dim strFile As String\r\n Dim strFolderpath As String\r\n Dim strDeletedFiles As String\r\n Dim strArray() As String \r\n Dim ac As Long\r\n Dim lSeq As Long\r\n Dim lPriority As Long\r\n Dim strLine As String\r\n Dim strField As String\r\n Dim strValue As String\r\n Dim strMethod As String\r\n Dim strUid As String\r\n Dim strSummary As String\r\n Dim strLocation As String\r\n Dim strDesc As String\r\n Dim strOrganizer As String\r\n Dim strDate As String\r\n Dim dtStart As Date\r\n Dim dtEnd As Date\r\n \r\n Dim hexUID\r\n \r\n ' Instantiate an Outlook Application object.\r\n Set objOL = Application\r\n \r\n Dim objNs As Outlook.NameSpace\r\n Set objNs = objOL.Session\r\n Dim objFolder As Outlook.MAPIFolder\r\n \r\n Set objFolder = objNs.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)\r\n Dim objAppts As Outlook.Items\r\n Set objAppts = objFolder.Items\r\n Dim objAppt As Outlook.AppointmentItem\r\n Dim strFilter As String\r\n \r\n \r\n \r\n ' Get the path to your My Documents folder\r\n strFolderpath = CreateObject(\"WScript.Shell\").SpecialFolders(16)\r\n On Error Resume Next\r\n\r\n\r\n ' Get the collection of selected objects.\r\n Set objSelection = objOL.ActiveExplorer.Selection\r\n''''''''''''''''''''\r\n'[snip] see code from Removing attachments post\r\n'''''''''''''''''''\r\n ' call function in different module\r\n ' this populates the string array from the iCalendar file\r\n icsFileToArray strFile, strArray\r\n \r\n ' check last element of array to determine if file previously processed\r\n If strArray(UBound(strArray)) = \"PROCESSED\" Then\r\n 'file already processed\r\n GoTo ExitSub\r\n Else\r\n ' loop through array to process event\r\n For ac = 1 To UBound(strArray)\r\n ' separate data pairs\r\n strLine = strArray(ac)\r\n If InStr(1, strLine, \":\") > 0 Then\r\n strField = Mid(strLine, 1, InStr(1, strLine, \":\") - 1)\r\n strValue = Mid(strLine, InStr(1, strLine, \":\") + 1)\r\n End If\r\n \r\n Select Case strField\r\n Case \"METHOD\"\r\n ' REQUEST or CANCEL\r\n strMethod = strValue\r\n Case \"UID\"\r\n ' Unique identifier for event\r\n strUid = strValue\r\n Case \"DTSTART\"\r\n ' pull out values into 'mm\/dd\/yyyy hh:mm:ss' format\r\n strDate = (Mid(strValue, 5, 2) & \"\/\" & Mid(strValue, 7, 2) & _\r\n \"\/\" & Mid(strValue, 1, 4) & \" \" & Mid(strValue, 10, 2) & \":\" & _\r\n Mid(strValue, 12, 2))\r\n dtStart = CDate(strDate)\r\n ' put datetime into Outlook format\r\n dtStart = Format(dtStart, \"\\#m\\\/d\\\/yyyy h:mm:ss AM\/PM\\#\")\r\n Case \"DTEND\"\r\n ' pull out values into 'mm\/dd\/yyyy hh:mm:ss' format\r\n strDate = (Mid(strValue, 5, 2) & \"\/\" & Mid(strValue, 7, 2) & _\r\n \"\/\" & Mid(strValue, 1, 4) & \" \" & Mid(strValue, 10, 2) & \":\" & _\r\n Mid(strValue, 12, 2))\r\n dtEnd = CDate(strDate)\r\n dtEnd = Format(dtEnd, \"\\#m\\\/d\\\/yyyy h:mm:ss AM\/PM\\#\")\r\n Case \"SUMMARY\"\r\n strSummary = strValue\r\n Case \"LOCATION\"\r\n strLocation = strValue\r\n Case \"ORGANIZER\"\r\n ' can not set this as of 6-30-2011\r\n strOrganizer = strValue\r\n Case \"PRIORITY\"\r\n lPriority = Val(strValue)\r\n Case \"SEQUENCE\"\r\n ' if an update must be > 0\r\n lSeq = Val(strValue)\r\n Case \"DESCRIPTION\"\r\n strDesc = strValue\r\n \r\n Case Else\r\n \r\n End Select\r\n Next\r\n End If\r\n ' check if appointment already exists for given UID\r\n 'convert UID to hex. this should match the GlobalAppointmentID if the item was\r\n ' imported manually\r\n 'Start with the standard preamble (original example had 26 and not 12 here)=======vv\r\n hexUID = \"040000008200E00074C5B7101A82E0080000000000000000000000000000000000000000120000007643616C2D55696401000000\"\r\n 'Now add the provided string\r\n For i = 1 To Len(strUid)\r\n hexUID = hexUID & CStr(Hex(Asc(Mid(strUid, i, 1))))\r\n Next\r\n 'Terminate the UID\r\n hexUID = hexUID & \"00\"\r\n ' this filter used if the new field is set to the GlobalAppointmentID\r\n strFilter = \"[UID] = '\" & hexUID & \"'\"\r\n Set objAppt = objAppts.Find(strFilter)\r\n If objAppt Is Nothing Then\r\n 'New event\r\n Dim myItem As Outlook.AppointmentItem\r\n Set myItem = objOL.CreateItem(olAppointmentItem)\r\n myItem.Start = dtStart\r\n myItem.End = dtEnd\r\n myItem.Subject = strSummary\r\n myItem.Location = strLocation\r\n myItem.Body = strDesc\r\n\t ' this was not working when I did this\r\n ' myItem.Organizer = strOrganizer\r\n\t ' add a new property \"UID\" to the event so it can be updated\r\n myItem.ItemProperties.Add \"UID\", olText, True\r\n myItem.Save\r\n myItem.ItemProperties.Item(\"UID\").Value = hexUID\r\n myItem.Save\r\n Else\r\n If strMethod = \"CANCEL\" Then\r\n ' remove item from calendar\r\n objAppt.Delete\r\n ElseIf lSeq > 0 Then\r\n ' update must have sequence > 0\r\n objAppt.Start = dtStart\r\n objAppt.End = dtEnd\r\n objAppt.Subject = strSummary\r\n objAppt.Location = strLocation\r\n objAppt.Body = strDesc\r\n objAppt.Save\r\n End If\r\n \r\n End If\r\n ' mark file processed\r\n icsWriteToFile strFile\r\n \r\nExitSub:\r\n\r\nSet objAttachments = Nothing\r\nSet objitem = Nothing\r\nSet objSelection = Nothing\r\nSet objOL = Nothing\r\nEnd Sub<\/pre>\nThe biggest issue I came across in dealing with Outlook is the ability to update or delete a previously scheduled event. One would think Microsoft could handle the setting of an ID which could then be used to find it consistently. Outlook does assign an ID to events but these get changed if you move them around. The ‘GlobalAppointmentID’ does get set (as a GUID) and remains constant but you have no way of searching for it (sigh). Anyway I get around this by adding a property to any Event created via this process and assign the UID (which is converted into a GUID) to it. This way I can do a simple ‘Find’ of my apppointments and process appropriately. Here are some links related to GUIDs and Outlook \t<\/p>\n