I completed some VBA code that will allow you to export appointment information (meetings, appointments) from Outlook into Excel. It requires a reference to the Outlook object library (unless you care to reengineer it), but it works even with Outlook closed. I think you'll find it very useful for when you need to examine or manipulate Outlook Calendar data, and want something a bit faster (and more flexible) than Outlook's built-in exporter.
The code begins by setting a reference to the Outlook Application object, which, depending on whether Outlook is open or not, can take up to 10 seconds, so I strongly recommend you have Outlook open when you run this code. Then we reference the default Calendar folder and filter out the items based on dates passed as arguments to the sub.
Because recurring appointments can potentially have an unlimited number of recurrences (when the organizer does not specify an End Date), we use the Restrict method to limit the number of calendar entries we need to return to only those that fall between 12 AM on the start date and 11:59 PM on the end date.
Be careful with the Restrict method, however; if you use it in an Exchange environment, it can slow down Outlook's performance.
Private Sub GetCalData(StartDate As Date, Optional EndDate As Date)
' -------------------------------------------------
' Notes:
' If Outlook is not open, it still works, but much slower (~8 secs vs. 2 secs w/ Outlook open).
' Make sure to reference the Outlook object library before running the code
' End Date is optional, if you want to pull from only one day, use: Call GetCalData("7/14/2008")
' -------------------------------------------------
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim myCalItems As Outlook.Items
Dim ItemstoCheck As Outlook.Items
Dim ThisAppt As Outlook.AppointmentItem
Dim MyItem As Object
Dim StringToCheck As String
Dim MyBook As Excel.Workbook
Dim rngStart As Excel.Range
Dim i As Long
Dim NextRow As Long
' if no end date was specified, then the requestor only wants one day, so set EndDate = StartDate
' this will let us return appts from multiple dates, if the requestor does in fact set an appropriate end date
If EndDate = "12:00:00 AM" Then
EndDate = StartDate
End If
If EndDate < StartDate Then
MsgBox "Those dates seem switched, please check them and try again.", vbInformation
GoTo ExitProc
End If
If EndDate - StartDate > 28 Then
' ask if the requestor wants so much info
If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then
GoTo ExitProc
End If
End If
' get or create Outlook object and make sure it exists before continuing
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
GoTo ExitProc
End If
Set olNS = olApp.GetNamespace("MAPI")
Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items
' ------------------------------------------------------------------
' the following code adapted from:
' http://www.outlookcode.com/article.aspx?id=30
'
With myCalItems
.Sort "[Start]", False
.IncludeRecurrences = True
End With
'
StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] <= " & _
Quote(EndDate & " 11:59 PM")
Debug.Print StringToCheck
'
Set ItemstoCheck = myCalItems.Restrict(StringToCheck)
Debug.Print ItemstoCheck.Count
' ------------------------------------------------------------------
If ItemstoCheck.Count > 0 Then
' we found at least one appt
' check if there are actually any items in the collection, otherwise exit
If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc
Set MyBook = Excel.Workbooks.Add
Set rngStart = MyBook.Sheets(1).Range("A1")
With rngStart
.Offset(0, 0).Value = "Subject"
.Offset(0, 1).Value = "Start Date"
.Offset(0, 2).Value = "Start Time"
.Offset(0, 3).Value = "End Date"
.Offset(0, 4).Value = "End Time"
.Offset(0, 5).Value = "Location"
.Offset(0, 6).Value = "Categories"
End With
For Each MyItem In ItemstoCheck
If MyItem.Class = olAppointment Then
' MyItem is the appointment or meeting item we want,
' set obj reference to it
Set ThisAppt = MyItem
NextRow = WorksheetFunction.CountA(Range("A:A"))
With rngStart
.End(xlDown).End(xlUp).Offset(NextRow, 0).Value = ThisAppt.Subject
.End(xlDown).End(xlUp).Offset(NextRow, 1).Value = Format(ThisAppt.Start, "MM/DD/YYYY")
.End(xlDown).End(xlUp).Offset(NextRow, 2).Value = Format(ThisAppt.Start, "HH:MM AM/PM")
.End(xlDown).End(xlUp).Offset(NextRow, 3).Value = Format(ThisAppt.End, "MM/DD/YYYY")
.End(xlDown).End(xlUp).Offset(NextRow, 4).Value = Format(ThisAppt.End, "HH:MM AM/PM")
.End(xlDown).End(xlUp).Offset(NextRow, 5).Value = ThisAppt.Location
If ThisAppt.Categories <> "" Then
.End(xlDown).End(xlUp).Offset(NextRow, 6).Value = ThisAppt.Categories
Else
.End(xlDown).End(xlUp).Offset(NextRow, 6).Value = "n/a"
End If
End With
End If
Next MyItem
' make it pretty
Call Cool_Colors(rngStart)
Else
MsgBox "There are no appointments or meetings during" & _
"the time you specified. Exiting now.", vbCritical
End If
ExitProc:
Set myCalItems = Nothing
Set ItemstoCheck = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set rngStart = Nothing
Set ThisAppt = Nothing
End Sub
Private Function Quote(MyText) ' from Sue Mosher's excellent book "Microsoft Outlook Programming" Quote = Chr(34) & MyText & Chr(34) End Function
Private Sub Cool_Colors(rng As Excel.Range)
'
' Lt Blue BG with white letters
'
'
With Range(rng, rng.End(xlToRight))
.Font.ColorIndex = 2
.Font.Bold = True
.HorizontalAlignment = xlCenter
.MergeCells = False
.AutoFilter
.CurrentRegion.Columns.AutoFit
With .Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
End With
End Sub
Let's examine exactly what is going on here.
Our sub accepts two arguments, the start date and end date. The end date is optional, in case we only want to check one day. If the end date is "12:00:00 AM", this means no end date was specified, therefore we can set the end date = start date.
If the end date is later than the start date, the user might have made an error; we can simply exit and allow them to rerun the sub.
After hooking the Outlook application and setting a reference to the default Calendar, we build a string used to restrict the Calendar items returned to only those that start or end within the date range arguments passed to the sub. The Restrict method has a funny way of requiring quotation marks, so using the Quote UDF from Sue Mosher's book Microsoft Outlook Programming ensures that our quotation marks will be formatted properly for the Restrict method.
Then it's a simple matter of copying the information from each appointment to a new workbook. Notice that I hand selected certain properties to export; you can export whatever properties you want (see Outlook 2003 VBA Reference). All you need to do is update the two "With rngStart" sections.
I exported the date and time as two separate fields, if you wanted to combine them it would be something like:
Format(ThisAppt.Start, "MM/DD/YYYY HH:MM AM/PM") Format(ThisAppt.End, "MM/DD/YYYY HH:MM AM/PM")
To export your Calendar items, just call the main sub like this:
Sub GetApptsFromOutlook()
Application.ScreenUpdating = False
Call GetCalData("7/20/2008", "8/6/2008")
Application.ScreenUpdating = True
End Sub
In the spirit of modularization, I broke out the code that pretties up the header row into its own sub; we just pass the header row as a Range object.
One minor issue we have to deal with is if there are no appointments, the code runs all the way to the For loop (after we have already populated the header row of the new worksheet) and then exits. This is because ItemstoCheck.Count returns 2147483647 (not 0), even if the date range we specified contains no appointments (based on my experiments). So if we pick a date range with no appointments, we'll end up with a useless blank spreadsheet with a populated header row.
The way we solve this problem is to add a line that checks to see if there are any actual objects found by the Restrict method, and exits if there's really nothing there. This line does just that.
If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc
Here is a sample of the finished product.
Enjoy,
JP
About JP
96 Comments:
What can be done to pass variables to the Start and End Dates so that we don't have to update the Sub each and every time we want to change the dates?
I'm pretty novice at this stuff. I've tried passing variables via a Range with the date and input boxes
Hey Ryan,
The sub is designed so you can change the start and end dates as needed.
Sub GetApptsFromOutlook() Application.ScreenUpdating = False Call GetCalData("7/20/2008", "8/6/2008") Application.ScreenUpdating = True End SubJust change the two arguments (dates) as needed.
If you wanted to hard code the start and end dates, just change the first line of the sub to:
And you would have to add
right below that.
HTH,
JP
First, I want to say thanks for making this available. I was able to get it to pull from my default calendar in about 10 minutes.
How can I pull events from a public calendar?
Thanks,
Mary
Hi Mary,
You can try to change line 57 to point to the public folder, but more likely you'll need to use CDO.
Although I did find a function here that might do what you want: http://www.outlookcode.com/codedetail.aspx?id=1164
–JP
Excellent!
Brilliant code, however i would also like to be able to include items which have been recently updated? I have (in a cell) the last update time of the sheet, and in a seperate sheet i want to show items which have been put into the calendar after that input time.
UpdateDate = Worksheets("Staff").Range("Updated_Date").Text StringToCheck = "[LastModificationTime] = " & Quote(StartDate & " 12:00 AM") & " AND [Start] <= " & _ Quote(EndDate & " 11:59 PM") Set ItemstoCheck = myCalItems.Restrict(StringToCheck)The format of the text in the update cell is 15/12/2008 09:23:05 (note 2 spaces in between date and time, that seems to be how outlook handles it).
Simply, it isnt working, and isnt showing up any updates which fall within the specified range (this is vital).
Many thanks
Try modifying the StringToCheck line as follows:
Then call it the usual way:
Sub GetApptsFromOutlook() Application.ScreenUpdating = False Call GetCalData("7/20/2008", "8/6/2008") Application.ScreenUpdating = True End SubThis should pick up any appointments that have been updated during that time frame.
Thanks JP, I tested that but it didnt work. In the meanwhile I have found another way of doing it.
in the portion which starts;
I have added a portion just after With rngStart which checks ThisAppt.CreationTime > UpdateDate and then inserts those items into my sheet. It will only do this if i call it from another button where i have a boolean value set to true. If the value is set to False, it will run through all of the items, ignoring the creationtime criteria set.
Your comparison will only pull appointments that were created after a date you specify. It doesn't actually check if the appointments are actually updated. That would defeat the purpose of having a sub where you specify the start and end dates as arguments. For example, you're calling the sub with the start date of 10/1/2008 and end date of 10/2/2008, then inside the sub you are changing the start date.
ps- it looks like you are using European dates? Just checking.
The CreationTime represents the date/time the appointment was created. If you update it later, the CreationTime wouldn't change. You need to compare the LastModificationTime with the CreationTime and only import those where the two are different (and where LastModificationTime <> 1/1/4501). Or am I misunderstanding what you're doing?
If it does what you want, that's all that matters, but I'm not understanding how it's working.
[I forgot to mention that if LastModificationTime equals 1/1/4501, that means the appointment has never been updated. --JP]
Basically, I have 2 sheets, each with a button on. First sheet fills with all of the appointments within the specified range. The second sheet is used for daily checking for new appointments so our office wall board can be updated much more easily.
As ongoing development i will be investigating using the LastModificationTime as well/instead of the CreationTime, but as it stands it seems to work quite well for our needs.
Many thanks for your suggestion as it sent me in the right direction of the solution.
Hello JP,
Thank you for your VBA codes. I'm a newbie with VBA. I run the script and got a compile error: "User-defined type not defined" on line 10 – Dim olApp As Outlook.Application
I have Outlook running. What am I missing?
Thanks,
–Tony
Tony,
You have to set a reference to the Outlook object library. Go to Tools » References and find "Microsoft Outlook Object 11.0 Library" and select it. When you run the code again, it should work.
JP,
Thanks for the code!
Is there a way to pull this from a shared calendar instead of just mine?
Thanks,
James
James,
You'll need to change
Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items
to point to the Calendar you want to extract from. For example if the name of the shared mailbox is "My Department", the line would be
Set myCalItems = olNS.Folders("Mailbox – My Department").Folders("Calendar").Items
HTH
My mistake, you probably want to use a technique like this to get a MAPIFolder object reference to a specific folder.
GetFolder
JP
I tried to access the shared calendar for another user Example
Set myCalItems = olNS.Folders("Mailbox – My Department").Folders("Calendar").Items
But this did not appear to work.
I receive an Run time error. It says an object can not be found. I tested that I can access the users calendar through outlook. Any ideas?
Thank you,
Mary
Mary,
You'll need to use the GetFolder Method to set a reference to the public calendar. The code here can get you started:
GetFolder Method
Here is the code to access a public folder..
You need to change
Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items
to
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Some Folder Name").Items
Change the "some folder name" to your calendar name.
Thanks,
Mary
Great job Mary! Thanks for commenting.
I'm using the code to extract my calendar items as per the first three code listings. I have a need to "parse" my categories creating two columns. Any suggestions on how to do this?
Or can you direct me to someone who can help.
Thank you!
I have figured out the parsing with some help from Experts-exchange.
I have one more "Challenge" to overcome….
I do not want to pull any appointment that have a 24 hour duration or is listed as a AlldayAppointment.
Can you Help?
Thank you!
Sub GetCMCTIMESheet(StartDate As Date, Optional EndDate As Date) ' ------------------------------------------------- ' Notes: ' If Outlook is not open, it still works, but much slower (~8 secs vs. 2 secs w/ Outlook open). ' Make sure to reference the Outlook object library before running the code ' End Date is optional, if you want to pull from only one day, use: Call GetCMCTIMESheet("7/14/2008") ' ------------------------------------------------- Dim olApp As Outlook.Application Dim olNS As Outlook.Namespace Dim myCalItems As Outlook.Items Dim ItemstoCheck As Outlook.Items Dim ThisAppt As Outlook.AppointmentItem Dim MyItem As Object Dim StringToCheck As String Dim MyBook As Excel.Workbook Dim rngStart As Excel.Range Dim i As Long Dim NextRow As Long ' if no end date was specified, then the requestor only wants one day, so set EndDate = StartDate ' this will let us return appts from multiple dates, if the requestor does in fact set an appropriate end date If EndDate = "12:00:00 AM" Then EndDate = StartDate End If If EndDate 28 Then ' ask if the requestor wants so much info If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then GoTo ExitProc End If End If ' get or create Outlook object and make sure it exists before continuing On Error Resume Next Set olApp = GetObject(, "Outlook.Application") If Err.Number 0 Then Set olApp = CreateObject("Outlook.Application") End If On Error GoTo 0 If olApp Is Nothing Then MsgBox "Cannot start Outlook.", vbExclamation GoTo ExitProc End If Set olNS = olApp.GetNamespace("MAPI") Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Folders("CMC - TimeSheet").Items ' ------------------------------------------------------------------ ' the following code adapted from: ' http://www.outlookcode.com/article.aspx?id=30 ' With myCalItems .Sort "[Start]", False .IncludeRecurrences = False End With ' StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] 0 Then ' we found at least one appt ' check if there are actually any items in the collection, otherwise exit If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc Set MyBook = Excel.Workbooks.Add Set rngStart = MyBook.Sheets(1).Range("A1") With rngStart .Offset(0, 0).Value = "Transaction Date" .Offset(0, 1).Value = "Customer" .Offset(0, 2).Value = "Service Item" .Offset(0, 3).Value = "Duration" .Offset(0, 4).Value = "Billiable" .Offset(0, 5).Value = "Notes" End With For Each MyItem In ItemstoCheck If MyItem.Class = olAppointment Then ' MyItem is the appointment or meeting item we want, ' set obj reference to it Set ThisAppt = MyItem NextRow = WorksheetFunction.CountA(Range("A:A")) With rngStart .End(xlDown).End(xlUp).Offset(NextRow, 0).Value = Format(ThisAppt.Start, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 1).Value = ThisAppt.Subject If ThisAppt.Categories = "" Then .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = "n/a" Else .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = IIf(InStr(1, ThisAppt.Categories, ",") > 0, _ Trim(Split(ThisAppt.Categories, ",")(1)), "") 'second category if applicable End If .End(xlDown).End(xlUp).Offset(NextRow, 3).Value = ThisAppt.Duration / 60 .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = IIf(InStr(1, ThisAppt.Categories, ",") > 0, _ Trim(Split(ThisAppt.Categories, ",")(1)), "") 'second category if applicable If ThisAppt.Categories Like "Billable-yes*" Then .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = "Y" ElseIf ThisAppt.Categories Like "Billable-No*" Then .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = "N" ElseIf ThisAppt.Categories "" Then .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = "n/a" End If .End(xlDown).End(xlUp).Offset(NextRow, 5).Value = (Format(ThisAppt.Start, "MM/DD/YYYY")) + " - " + ThisAppt.Body End With End If Next MyItem ' make it pretty Call Cool_Colors(rngStart) Else MsgBox "There are no appointments or meetings during" & _ "the time you specified. Exiting now.", vbCritical End If ExitProc: Set myCalItems = Nothing Set ItemstoCheck = Nothing Set olNS = Nothing Set olApp = Nothing Set rngStart = Nothing Set ThisAppt = Nothing End Sub Private Function Quote(MyText) ' from Sue Mosher's excellent book "Microsoft Outlook Programming" Quote = Chr(34) & MyText & Chr(34) End Function Private Sub Cool_Colors(rng As Excel.Range) ' ' Lt Blue BG with white letters ' ' With Range(rng, rng.End(xlToRight)) .Font.ColorIndex = 2 .Font.Bold = True .HorizontalAlignment = xlCenter .MergeCells = False .AutoFilter .CurrentRegion.Columns.AutoFit With .Interior .ColorIndex = 41 .Pattern = xlSolid End With End With End SubMary,
Right after
Add in this line:
And right before the closing End If, add another End If.
HTH
This worked perfect!
Thanks for your help…
This code has allow us to pull tracked time from public calendars to a excel file that is in perfect format to import into quickbooks.
This will allow our administrative asst. to save approx. 19 hours a month.
I was wondering if you can tell me if there is a way to have a window pop up an prompt the user to enter a date instead of going into the macro and changing it. I'm assuming I would need to use sometype of variable. I was also thinking it would be cool if you could pull more than one calendar at time..I'm going to work on that in my free time.
If you can even direct me on the window prompting I would certainly appreciate it.
I have ordered a VB book that I'm hoping will help me. Thank you for all you have done. Your code has helped me greatly.
Check out the InputBox function. The end user would enter the start and end dates, then you call the function and pass that information as parameters. This sample code doesn't include any error handling, but should get you started.
Dim dteStart As Date Dim dteEnd As Date dteStart = InputBox("What is the start date?") dteEnd = InputBox("What is the end date?") Call GetCalData(dteStart, dteEnd)As far as pulling from multiple calendars, that would be more difficult. The default Calendar is easy, because everyone has it, and GetDefaultFolder always finds it. But everyone has different (public) calendars, and some don't have any at all. How would you specify which calendar to export from?
I have managed to do the above requested by using the following. Please excuse my code as its rather cribbed together.
Firstly, my workbook has 3 sheets, Weekly, Updated and Staff. A cell on weekly has a range name of From_Date, and another To_Date. Another cell on Updated has a range name of from_date_updated.
My staff sheet has a list of names contained on it working downwards in column A. This is a list of calendar names (staff names in my case).
Weekly has a button called bt_1. Updated has a button called bt_recent.
Dim NextRow As Long Sub bt_1() Dim xrows As Integer Dim txtout As String Dim from As Date Dim todate As Date Dim SheetNameVar As String Dim ChkUpdateVar As Boolean SheetNameVar = ("Weekly") ChkUpdateVar = False from = Worksheets(SheetNameVar).Range("from_date").Value todate = Worksheets(SheetNameVar).Range("to_date").Value Worksheets(SheetNameVar).Range("A3:H1000").Clear xrows = 1 Do Until Worksheets("Staff").Cells(xrows, 1).Value = "" txtout = Worksheets("Staff").Cells(xrows, 1) xrows = xrows + 1 Application.ScreenUpdating = False Call GetCalData(from, txtout, SheetNameVar, ChkUpdateVar, todate) Application.ScreenUpdating = True Loop End Sub Sub bt_recent() Dim xrows As Integer Dim txtout As String Dim fromupdate As Date Dim todateupdate As Date Dim SheetNameVar As String Dim ChkUpdateVar As Boolean SheetNameVar = ("Updated") ChkUpdateVar = True fromupdate = Worksheets("Weekly").Range("from_date").Value todateupdate = Worksheets("Weekly").Range("to_date").Value Worksheets(SheetNameVar).Range("A3:H1000").Clear xrows = 1 Do Until Worksheets("Staff").Cells(xrows, 1).Value = "" txtout = Worksheets("Staff").Cells(xrows, 1) xrows = xrows + 1 Application.ScreenUpdating = False Call GetCalData(fromupdate, txtout, SheetNameVar, ChkUpdateVar, todateupdate) Application.ScreenUpdating = True Loop End Sub Public Function GetCalData(StartDate As Date, StaffName As String, SheetName As String, ChkUpdateFlag As Boolean, Optional EndDate As Date) Dim olApp As Outlook.Application Dim olNS As Outlook.Namespace Dim myCalItems As Outlook.Items Dim ItemstoCheck As Outlook.Items Dim ThisAppt As Outlook.AppointmentItem Dim MyItem As Object Dim StringToCheck As String Dim MyName As Outlook.Recipient Dim CalendarFolder As Outlook.Folder Dim MyBook As Excel.Workbook Dim rngStart As Excel.Range Dim i As Long Dim UpdateDate As Date UpdateDate = Worksheets("Updated").Range("from_date_update").Value If EndDate = "12:00:00 AM" Then EndDate = StartDate End If If EndDate 28 Then If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then GoTo ExitProc End If End If On Error Resume Next Set olApp = GetObject(, "Outlook.Application") If Err.Number 0 Then Set olApp = CreateObject("Outlook.Application") End If On Error GoTo 0 If olApp Is Nothing Then MsgBox "Cannot start Outlook.", vbExclamation GoTo ExitProc End If Set olNS = olApp.GetNamespace("MAPI") Set MyName = olNS.CreateRecipient(StaffName) MyName.Resolve On Error Resume Next Set myCalItems = olNS.GetSharedDefaultFolder(MyName, olFolderCalendar).Items With myCalItems .Sort "[Start]", False .IncludeRecurrences = True End With StringToCheck = "[End]>= " & Quote(StartDate & " 12:00 AM") & " AND [Start] 0 Then If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc Set rngStart = Worksheets(SheetName).Range("A3") With rngStart .Offset(0, 0).Value = "Name" .Offset(0, 1).Value = "Subject" .Offset(0, 2).Value = "Location" .Offset(0, 3).Value = "Start Date" .Offset(0, 4).Value = "Start Time" .Offset(0, 5).Value = "End Date" .Offset(0, 6).Value = "End Time" If ChkUpdateFlag = False Then '.Offset(0, 7).Value = "Category" Else .Offset(0, 7).Value = "Creation Date" End If End With For Each MyItem In ItemstoCheck If MyItem.Class = olAppointment Then Set ThisAppt = MyItem NextRow = WorksheetFunction.CountA(Range("A:A")) With rngStart If ChkUpdateFlag = True Then If ThisAppt.CreationTime > UpdateDate Then .End(xlDown).End(xlUp).Offset(NextRow, 0).Value = MyName .End(xlDown).End(xlUp).Offset(NextRow, 1).Value = ThisAppt.Subject .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = ThisAppt.Location .End(xlDown).End(xlUp).Offset(NextRow, 3).Value = Format(ThisAppt.Start, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = Format(ThisAppt.Start, "HH:MM AM/PM") .End(xlDown).End(xlUp).Offset(NextRow, 5).Value = Format(ThisAppt.End, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 6).Value = Format(ThisAppt.End, "HH:MM AM/PM") .End(xlDown).End(xlUp).Offset(NextRow, 7).Value = ThisAppt.CreationTime End If Else .End(xlDown).End(xlUp).Offset(NextRow, 0).Value = MyName .End(xlDown).End(xlUp).Offset(NextRow, 1).Value = ThisAppt.Subject .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = ThisAppt.Location .End(xlDown).End(xlUp).Offset(NextRow, 3).Value = Format(ThisAppt.Start, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = Format(ThisAppt.Start, "HH:MM AM/PM") .End(xlDown).End(xlUp).Offset(NextRow, 5).Value = Format(ThisAppt.End, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 6).Value = Format(ThisAppt.End, "HH:MM AM/PM") '.End(xlDown).End(xlUp).Offset(NextRow, 7).Value = ThisAppt.Categories End If End With End If Next MyItem Call Cool_Colors(rngStart) Else MsgBox "There are no appointments or meetings during the time you specified. Exiting now.", vbCritical End If ExitProc: Set myCalItems = Nothing Set ItemstoCheck = Nothing Set olNS = Nothing Set olApp = Nothing Set rngStart = Nothing Set ThisAppt = Nothing End Function Private Function Quote(MyText) Quote = Chr(34) & MyText & Chr(34) End Function Private Sub Cool_Colors(rng As Excel.Range) ' ' Lt Blue BG with white letters ' ' With Range(rng, rng.End(xlToRight)) '.Font.ColorIndex = 2 .Font.Bold = True .HorizontalAlignment = xlCenter .MergeCells = False .AutoFilter .CurrentRegion.Columns.AutoFit 'With .Interior ' .ColorIndex = 41 ' .Pattern = xlSolid 'End With End With End SubJP,
The input code worked GREAT! Your are awesome…So I would use this.. with the "some Folders name" changing per user. I would also need to put this "somefoldername" in the excel spreadsheet so we know whos are whos. So I would add a column and call it user.
As far as the calendars they are public
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Some Folder Name").ItemsDavid — great job!
Mary — check out David's code above. He added another argument to the function to change the Calendar to be searched. Then you just pass in the name of the public Calendar you want to search.
How can I add a save file as to the orginal code. I would like for the user to run the macro and then it auto save the file with todays date or "text" that I specify.
Thank you,
Mary -
After
put something like this:
If you wanted to specify text, you could either hard code it into the macro, or you'd need to add an additional argument to the macro (like in David's code above) and then use that for the filename. For example, change the first line of the macro to
Then call the macro like this:
GetCalData("11/1/2008", "11/10/2008","Friend")Then use the variable "strText" where you want it — in the filename…
Hi all.
I am very new to VBA but I wanted to try this code out. I actually type out a meeting schedule everyday and I thought this might help expedite the process. I don't know how to execute this code in the Excel workbook. Can anyone give me a little push to get me started?
Thank you,
Nathan
Nathan,
Here are some instructions that should help you. If not, contact me privately and I can send you the relevant code sections.
1) Start Microsoft Excel.
2) Press Alt-F11 to access the VB Editor.
3) Create a new standard module, copy the above code sections into it (see http://www.rondebruin.nl/code.htm assistance with where to place the code). You just click "view plain" above each code section, then cut and paste the resulting code.
4) Copy and paste the "GetApptsFromOutlook" code above, and edit it so it pulls from the appropriate date range.
5) Click anywhere inside the "GetApptsFromOutlook" code and press F5 to run the code.
Thanks JP. I got it to execute in the workbook but I get compile error here:
It tells me the "Quote()" function is not defined.
Any idea why that is?
Thanks,
Nathan
Make sure you copy the Quote function into the module as well. It's listed above but here it is again.
Thank you very much that did work.
Glad to hear it Nathan.
JP,
Let me ask you a question. Would it be possible to access a calendar in another account on an exchange server if you had the username and password for the account?
We have a situation where that occurs because of having meeting rooms set up with their own inbox for meeting requests.
Sounds like a long shot but I thought I would ask.
Thanks again,
Nathan
Do you mean a shared calendar, or a completely different user's calendar? If the latter, you'd need to have access to it, I think it's more than a matter of having the username and password. Since it's a calendar, you can add the profile to your account and access the calendars that way. See http://www.jpsoftwaretech.com/blog/2009/01/handling-multiple-inboxes/ for more information.
Mary actually commented above with the necessary code:
You need to change
to
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Some Folder Name").ItemsChange the "some folder name" to your calendar name.
Great code but im tryin to make it work on an existing excel worksheet with a command button at the top of the sheet. The code seems to open a brand new excel sheet when the command button is pressed when calling the code.
How would i modify:
Set MyBook = Excel.Workbooks.Add
Set rngStart = MyBook.Sheets(1).Range("A1")
to work on an existing defined range already defined in excel so i dont need to define it in the code over again.
For example A2:F2 is already set to rngStart. A1 has commandbutton "View Appointments"
The problem is, you would have to know how many appointments Outlook is going to return. What happens if your range has three rows, but you have ten appointments? The results are unpredictable.
If you did have a pre-existing workbook set up already, with a named range where you want the results to go, you need to rewrite the code to open that workbook instead, and write the results there. For example,
Set MyBook = Excel.Workbooks.Open("C:\My_Existing_Workbook.xls") Set rngStart = MyBook.Sheets(1).Range("A2")If you wanted the results to start in cell A2.
HTH
Hi
Thank you for a very useful piece of code, being an Ada programmer I never realised VBA could read between outlook applications.
However I am stuck. I have the same problem as Tony on 22 Dec:
Thank you for your VBA codes. I'm a newbie with VBA. I run the script and got a compile error: "User-defined type not defined" on line 10 – Dim olApp As Outlook.Application.
I am running Office 2007 and Excel References Microsoft Object Library 12.0. Is that the problem? I have installed the Outlook PIA lbraries with no success. Is it posible to reference the 11.0 library?
Cheers
John
John,
Change the 'As Outlook' references to 'As Object' and it should work. Looking at the code again, it's a bit inefficient so I'll put it on my list of code to rewrite. I'll try to post the updated code within the week.
Thanks!
Hi JP
Thank worked. I had to add the line
Const olFolderCalendar = 9
Kind Regards
John
Hi David,
Could you please post your excel file? There are some characters missing in your code.
Thanks!
I fixed the VBA code in his comment, the code plugin munged it a bit. See if that helps.
Hi,
I tried to get this up and running with a public folder on our exchange server. I finally got this to compile:
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("CCR").ItemsBut it won't return any of the appointments in the "Community Teams" Calendar which sits in the CCR folder. The script tells me there are no appointments.
The actual folder path is this:
Public Folders\All Public Folders\CCR\Community Teams
"Community Teams" is the calendar.
But if I write it like this:
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFoldersCCR).Folders("Community Teams").ItemsIt says the folder is empty (CCR), and has a compiler error.
I can see the appointments in the calendar, any suggestions?
Try this:
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("CCR").Folders("Community Teams").ItemsHi JP,
This is awesome code – I've been looking around on the net for something usable all day!
I'm pretty new to VBA, and am having some trouble with the following line:
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Some Folder Name").Items
I have one calendar especially (my boss's – a shared calendar) that I need to export, but I can't seem to get it to work …
Do you have any tips?
Thanks
Brigette
Brigette,
See my response to Jon above, you need to walk the folder hierarchy to get to the folder you need.
Hi JP,
Worked brilliantly! Thanks for your help,
Jon
Hello JP, your code works great. I re-wrote it so its more visual on a VB form rather than looking on an plain Excel sheet, i removed the reference that it exports to a new Excel sheet but works all in one Excel file, the VB form gives it a professinal look.
All i did was, create a VB form with a listbox, renamed a blank sheet called "Appointments", set a range in cell A2 to show required data in listbox1 with: ActiveWorkbook.Names.Add Name:="Apps", _
RefersTo:="=OFFSET(Appointments!$A$2,0,0,COUNTA(Appointments!$A$2:$A$1000),COUNTA(Appointments!$1:$1))"
And entered the following modified code
Private Sub GetCalData(StartDate As Date, Optional EndDate As Date) Dim olApp As Outlook.Application Dim olNS As Outlook.Namespace Dim myCalItems As Outlook.Items Dim ItemstoCheck As Outlook.Items Dim ThisAppt As Outlook.AppointmentItem Dim MyItem As Object Dim StringToCheck As String Dim MyBook As Excel.Workbook Dim rngStart As Excel.Range Dim i As Long Dim NextRow As Long If EndDate = "12:00:00 AM" Then EndDate = StartDate End If If EndDate < StartDate Then MsgBox "Those dates seem switched, please check them and try again.", vbInformation, "Information" GoTo ExitProc End If If EndDate - StartDate > 31 Then If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then GoTo ExitProc End If End If On Error Resume Next ActiveWorkbook.Names.Add Name:="Apps", _ RefersTo:="=OFFSET(Appointments!$A$2,0,0,COUNTA(Appointments!$A$2:$A$1000),COUNTA(Appointments!$1:$1))" Set olApp = GetObject(, "Outlook.Application") If Err.Number <> 0 Then Set olApp = CreateObject("Outlook.Application") End If On Error GoTo 0 If olApp Is Nothing Then MsgBox "Cannot start Outlook. Please manually start Outlook.", vbExclamation GoTo ExitProc End If Set olNS = olApp.GetNamespace("MAPI") Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items ' ------------------------------------------------------------------ With myCalItems .Sort "[Start]", False .IncludeRecurrences = True End With ' StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] <= " & _ Quote(EndDate & " 11:59 PM") Debug.Print StringToCheck ' Set ItemstoCheck = myCalItems.Restrict(StringToCheck) Debug.Print ItemstoCheck.Count ' ------------------------------------------------------------------ Call ClearAppointments If ItemstoCheck.Count > 0 Then If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc Set rngStart = ThisWorkbook.Sheets("Appointments").Range("A1") With rngStart .Offset(0, 0).Value = "Subject" .Offset(0, 1).Value = "Category" .Offset(0, 2).Value = "Start Date" .Offset(0, 3).Value = "Start Time" .Offset(0, 4).Value = "End Time" .Offset(0, 5).Value = "Duration" End With For Each MyItem In ItemstoCheck If MyItem.Class = olAppointment Then Set ThisAppt = MyItem NextRow = ThisWorkbook.Sheets("Appointments").Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Row With rngStart .End(xlDown).End(xlUp).Offset(NextRow, 0).Value = ThisAppt.Subject .End(xlDown).End(xlUp).Offset(NextRow, 1).Value = ThisAppt.Categories .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = Format(ThisAppt.Start, "ddd - DD/MMM/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 3).Value = Format(ThisAppt.Start, "HH:MM AM/PM") .End(xlDown).End(xlUp).Offset(NextRow, 4).Value = Format(ThisAppt.End, "HH:MM AM/PM") .End(xlDown).End(xlUp).Offset(NextRow, 5).Value = ThisAppt.Duration & " Minutes" ListBox1.RowSource = "Apps" End With End If Next MyItem Else MsgBox "There are no appointments or meetings during" & _ "the time you specified.", vbCritical, "Information" GoTo ExitProc End If ExitProc: Set myCalItems = Nothing Set ItemstoCheck = Nothing Set olNS = Nothing Set olApp = Nothing Set rngStart = Nothing Set ThisAppt = Nothing End SubThis works brilliant and its very visual but how can i add when double clicked on a row in listbox1 it views the Outlook appointment selected, tried appt.display but no luck..
Please can anyone help?
You don't have a variable named 'appt' so 'appt.display' wouldn't do anything.
Listboxes have a DblClick event that occurs when the listbox is double clicked. You would need to determine which item or items were selected when the user double clicks the listbox, then decide how you want to "view" the appointment. You can display the details in a messagebox, or create a separate userform with a textbox and show the form from your DblClick event.
Hi JP
This dialogue is the most helpful I've ever seen. That being said, I too am a VBA newbie, and have a few questions. (1) why does John Hutchinson on Mar 25, 2009 set "Const olFolderCalendar = 9" (ie what is the significance of 9?) and (2) I get a compile error of olAppointment "variable not defined." Should I make John's modification?
Thanks!!
Matthew,
If you don't set a (early bound) reference to the Outlook Object Library (via Tools » References in the VBIDE), you have to declare your Outlook objects As Object (late bound). You also can't use Outlook's enumerated constants, but only their numerical equivalents. So the answer to question 1 is that if you put back a constant with the same name and value as the Outlook constant, you can use the same syntax as if you had set that reference. It's a good trick, and if you later change to early bound, you can comment out the constants and otherwise not have to change your code at all.
(2) olAppointment is another built in Outlook constant. Since we're checking the item's class, we'll need the constant value for the olAppointment class. If you change it to 26, the code should work. See the olObjectClass constant at http://msdn.microsoft.com/en-us/library/aa219371(office.11).aspx
HTH
Thanks for all this it's great. I searched high and low for an easy solution and this has saved me. However I need to pull out the labels from the appointments – Is it possible?
What do you mean "labels" ? This code will extract the following.
Subject
Start Date
Start Time
End Date
End Time
Location
Categories (if applicable)
If you need more information from an appointment, you'll need to edit the code and add the properties you want to extract.
Hi JP,
I running outlook 2003 client on a exchange 2007 server and the I’m after the labels you can edit in 2003 client.
For example you can colour a calendar item and “label” it important, personal etc.
I don’t necessarily have to pull out the text from this field – I will happily take an integer, RGB value or anything but can’t seem to find the right code to pull it out.
The code I have found just confused the heck out of me and isn’t as tidy as what you have here. Basically I am a VB amateur and am desperately trying to report on appointments in a number of calendars but the “Label” field is essential.
Thanks in advance for any ideas!
Hi again JP
Following up on DAH's question can the script extract custom labels? I have a custom form that provides a record of mileage on a particular event. When I substitute this label for "Location" in your code I still get the content from location. Is there a trick to referencing the content of the "milage" label to the heading?
Matthew
Hold that thought. I missed the next reference to "Location" and once changed to my "Mileage" the script worked beautifully. How is works is still a mystery to me but that it works is wonderful. Thanks a million!
Matthew
DAH,
I think I found your answer:
http://www.outlookcode.com/codedetail.aspx?id=139
Thanks JP, I have been trying to integrate that code but it looks as though it's a bit beyond me; i'll keep trying and post it if I get any success. Thanks again.
Aziz, have you also got the "ClearAppointments" function somewhere which you use in your code? I did not find it anywhere here…
regards,
WM
Wow, never expected to find such a fine piece of code!! I have been working with VBA for a couple of years previously but I am quite rusty nowadays. Therefore this piece gave me a huge headstart.
As many others here I also need a variation to it and I am stuck, hoping for some insight here.
I have designed a Custom Form to enter 4 user defined fields in addition to the normal Appointment data. I would like to pull these fields also into the Excel sheet, but have so far not found anything how to reference these fields.
Can anybody push me into the right direction?
with best regards,
AK
As usual when you sink in too much into a problem, you should step away and sleep over it
After a good sleep I looked at it again and found the solution in an instant.
For anybody interested, the custom fields can be referenced by ThisAppt.Userproperties("Custom Field Name")
As I said, just needed some sleep
with best regards
AK
Hi,
I develop VB.net 2008 with c# Application for fetch appoitment item from outllook 2003.
I need to show the contact with their mobile number,which are stored in outlook contact
related to the appointments in calender.
[cc lang='csharp']
int i = 0;
Outlook.Application oApp = new Outlook.Application();
Outlook.NameSpace oNS = oApp.GetNamespace("MAPI");
oNS.Logon(Type.Missing, Type.Missing, false, true);
Outlook.MAPIFolder Ocalender = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar);
Outlook.Items oItems = Ocalender.Items ;
int iNumContacts = oItems.Count;
Outlook.AppointmentItem c = (Outlook.AppointmentItem)(oItems[1]);
string sub = c.Subject;
string body = c.Body;
[/vb]
If someone need more description abt this,kindly ask
Plz. help
Thanks in Advance
Pratik Asthana
Great Code!
I'm using this to return the calendar items:
For Each MyItem In ItemstoCheck If MyItem.Class = olAppointment Then ' MyItem is the appointment or meeting item we want, ' set obj reference to it Set ThisAppt = MyItem Dim CoLChk As Long CoLChk = Range("GetCalendar").column NextRow = WorksheetFunction.CountA(Columns(CoLChk)) With rngStart .End(xlDown).End(xlUp).Offset(NextRow, 0).Value = ThisAppt.Subject .End(xlDown).End(xlUp).Offset(NextRow, 1).Value = Format(ThisAppt.Start, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 2).Value = Format(ThisAppt.End, "MM/DD/YYYY") .End(xlDown).End(xlUp).Offset(NextRow, 3).Value = ThisAppt.Location End With End If Next MyItemHow can I also return the Label Property description with each item…ThisAppt.Label does not do it.
Thanks
Eric.
You'll need to use CDO to do this.
See http://www.outlookcode.com/codedetail.aspx?id=139 for sample code.
Sue is my hero, goddess and idol all rolled into one.
I had already done some work with extracting data from forms, and had someone ask if we can report on an Outlook booking system. I replied saying I knew it was possible and it would be just an extension of what I had done before. But of course I am extremely busy and can't commit to much. But I would, of course, have a play to see what I can do.
One Google search, a cut and paste, and a very small tweak to make it work for me and I sent them back a response "Playtime over".
My people want to set up a fleet booking system in Outlook and be able to report on it. Looks like I can deliver what they want and save our organisation thousands of dollars in the process.
Thanks for sharing, Gravey!
Actually JP – I must apologise. I thought the entire code was from Sue's book. I must ensure I include you in my directory of god-like creatures.
Eight weeks ago I had not even seen behind an outlook form. Plenty of Excel VB experience but nothing with the interfaces between the systems. This forum and others has given me the confidence to approach almost anything.
Really appreciate it.
Thank you much for the code – saved me a tremendous amount of time.
I'm pulling data from a calendar what was populated with a form that has a combo box with two columns.
The bound column is set to the first column (has to be) and I can retrieve the value stored from the input of the bound column with:
… ThisAppt.UserProperties("Client")
Is it possible to retrieve the value of the second column corresponding with the correct first column?
Thank you so much.
Robert,
You should be able to use the Column Property of the combo box to determine the appropriate value. This is all I could find about the Column property:
http://msdn.microsoft.com/en-us/library/aa203907%28office.11%29.aspx
I just wanted to say thanks so much to everyone once again. I've been writing VBA for excel for several years but in the last few months it has all just exploded. I know understand things that I never knew possible.
From having an Outlook/Excel interface dumped on me, and then being asked to create something to allow our Procurement people to download an Outlook-based booking system for fleet vehicles into excel to extracting AD information, my head is still spinning.
Your code, JP, stunned my colleagues when they asked me to deal with the booking system. I said I would have a look at it, and a a google lead me to your site, and within 5 minutes I was able to provide them with an example (that's yours) of what could be done.
Sorry to hi-jack to post, but the only issue I am now struggling with is being able to extract all users from AD. There's plenty of sample code around for extracting individual user details, but I just can't make sense of it all to give me all current users in AD. The organisation should have around 3,500 users.
I manage a system access report that pulls data from several operational systems and merges it with AD information, and I want to make sure I can always have up to date AD extracts without relying on anyone else. It has links through MS Query to a Sybase SQL database to get user information from one system, pulling tables out of another LDAP repository to get user information from another system, pulls in an extract from a third system, and then uses AD data to make it all make sense. This is an organisation with dozens of separate systems, hundreds of interfaces between systems, and over 70 interfaces to external organisations.
You may want to check out the CDO For Exchange object model. I can't seem to locate any good documentation, however.
One final thing (from me at least): Does it make a difference whether the Outlook object is a resource as opposed to a user? I would have thought not as they are both just GAL objects. Yes?
I'm not clear what you mean. Can you give an example?
Sorry – ignore me. I just realised my folly.
I was thinking that the GAL somehow distinguished between an object that could only be selected as a resource (say when booking a meeting) and a user.
I think that we identify Resources by a prefix of "~". I'll just use that and go back to sleep.
Many apologies.
Thanks to you, I now have three different projects on the go that make use of some really nifty tricks. I have an feedback form that assigns itself a reference number by reading through all existing reference numbers in a mailbox, and when the response to the feedback is sent , it again reads through the mailbox to move all other forms with the same reference number to a completed folder. I am eternally grateful.
Hi,
Wow great code! Thanx for sharing!
I would like to add a filter to only retrieve the items with a special category (holidays).
Unfortunately I've got errors caused by my German language settings:
My filter:
StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] <= " & _
Quote(EndDate & " 11:59 PM") ' & " AND ([Kategorien] = 'Urlaub')"
But I get no items at all (all filtered out)
if I set it to [Categories] = 'Urlaub' I get an error saying "condition invalid"
I think due to german language installation?
Is there any way to fix this ? Maybe an code instead of clear naming "Categories"?
By the way: Debug.Print ItemstoCheck.Count always returns the max number…
If you want to count the filtered items you'll have to do it in a counting loop:
Debug.Print ItemstoCheck.Count ' returns max number
For Each obj In ItemstoCheck
i = i + 1
Next
Debug.Print i 'returns real number of filtered items
Best regards, once again thank you!!
You can't restrict items by category.
http://msdn.microsoft.com/en-us/library/aa210275%28office.11%29.aspx
http://msdn.microsoft.com/en-us/library/bb220369.aspx
Hi JP,
Great code, its really helpful. However, I'm having a problem access other users calendars.
The calendar is in the folder:
outlook:\\Mailbox – Smith, John\Calendar
I've tried using:
Set myCalItems = olNS.GetDefaultFolder(olFoldersAllPublicFolders).Folders("Mailbox – Smith, John").Folders("Calendar").Items
It tells me "one or more parameter values are not valid".
Do you have any suggestions?
You'll probably need to use:
1. The GetSharedDefaultFolder Method
i.e.
olNS.GetSharedDefaultFolder(recipient, olFolderCalendar)
Where 'recipient' is a Recipient Object that resolves to John Smith. If you don't have a Recipient object, create one using the CreateRecipient Method.
olNS.GetSharedDefaultFolder(olNS.CreateRecipient("John Smith"), olFolderCalendar)
or
2. Walk through the folder hierarchy minus the default folder
olNS.Folders("Mailbox – Smith, John").Folders("Calendar").Items
Hey JP,
The getSharedDefaultFolder method worked. Thanks for the help. This will save us tons of time.
Hi!
First of all this is a great code! But so far I have not been able to access shared calendars from Outlook. I've tried working my way through the hierachy :
Set myCalItems = olNS.Folders("Mailbox – John Smith").Folders("Calendar").Items
This actually works fine testing it on my own calendar, but I get an error when trying to acces shared calendars. Can anyone help me clarify what I'm doing wrong?
I've also tried using the GetSharedDefaultFolder Method, but without any luck so far. It's only the public calendar where I have been able to find the path for.
Loocking forward hearing from you!
This code sounds fantastic for what i am wanting to do. Done some minor XL code for emails but never calendar stuff.
Fairly experienced w/ Excel.
Is this to be run from inside XL or Outlook? From the first portions of code I would think excel?
I personally dont need the XL integration for what i want to do
(which is iterate through calendar entries imported from MS project and set those created from it, and are multi day events to set the ALL DAY event to YES/TRUE) so it displays on my phone more clearly.
Finally got this to work by adding the reference? has the alternative revs been posted? I'd prefer an OLK version only cause i dont need to output to EXCEL…but otherwise this was terrific and got me nearly everythign I want to do….many thanks JP
This code is meant to be used inside Excel. It can easily be adapted to run inside Outlook using the technique found here:
http://www.jpsoftwaretech.com/blog/2009/03/outlook-version-of-getdistlistmembers/
This page is great JP. Many thanks, I can not believe over years of searching I've not stumbled across this before. Outlook reference information is much harder to come by say versus Excel.
I got this ported to pure Outlook I think.
Got it doing what I wanted but came to realize it didnt help, due to phone.
For your reference if interested, I have an iPhone and at work we're relegated to using MS Project. There is a web plugin that will import Project events into your Outlook Calendar. And I wanted to get events converted to ALL DAY tasks. This worked but unfortunately the iPhone does not interpret ALL DAY tasks when they SPAN more than one day in the DAY View of the native Calendar App.
What I DID realize was that the iPhone can support multiple calendars / folders so I'm now trying to copy those appointements into a sub folder and then make an entry / day for any all day tasks so it manifests more clearly on my mobile.
For example if I have a
SERVER upgrade in MAIN Calendar that spans 5 days and are all day.
I'd like to get 'Server upgrade' set in MAIN SUB Folder that is ALL DAY, but a single day for 5 days /ea
If you have any insights I would welcome them.
I'm not clear on what you're trying to do. You want to convert certain appointments to tasks?
"All Day" only applies to appointments/meetings, not tasks.
Sorry JP, probably semantics/miscommunicated. I realize OLK tasks are as such.
To clarify, we are forced to schedule stuff via MS Project which myself colleagues dont care for.
We all like to manage our times/schedules (and what work we need to focus on) via our OUTLOOK calendars.
There is a MS OLK plugin that can import your MS Projects events/tasks into MS outlook as either tasks/calendar appts. Via PC the calendar looks fine, events that are ALL DAY show up isolated at the top vs hourly mtgs/appts.
The appointements is what I (we'd) like, as you can see them via your Mobile phone.
Personally I have an iPhone. The problem is the iPhone has 3 views, LIST / DAY / MONTH, the 1st and 3rd aren't very useful and while a weekly would be most optimum only the DAY is useful.
The issue is the iPhone calendar doesnt process appointments that SPAN MULTI day appointments well. It does it differently / view.
in the DAY view, it will color all 24 hrs w/ a appointment vs the thin "ALL DAY" listing of it. Then if you have multiple appointments it layers one of top of each other, making all of them unreadable.
What I did find was the iphone calendar and palm's pre o/s do support MULTIPLE calendars. and seperate the calendars appointments by calendar.
So what I was hoping was to have a VBA code, read my next monthy calendar appoinments in the default MAIN calender.
if they are multiday events or (should be all day but wont be imported as such from the plugin)
And make the necessariy individual ALL DAY appointements in the SECONDARY calendar to make it viewable via phone.
So for example say i have an EVENT in calendar that is VACATION that is M 8am to F 5pm, in MAIN calendar.
In the SECONDARY calendar I'd like to check for / if not create a entry VACATION – ALL DAY, for M / T / W / Th / F in that calendar so they are claerly identified in that calendar so the phone can process the way people like
I'm not sure how easy or hard this would be I could see it being harder than envisioned or perhaps more simple than I think. I am not opposed to manually running this code manually as needed nor pre deleting the SECONDARY calendar if prechecking events is too difficult…as the plugin may update if a mtg or apptment changes, it may be easier to just purge the SECONDARY calendar and reprocess it every time (which may be easier to code was well)
Is this any clearer? Maybe you could even tell me if possible or if way too difficult to be practical. I think you've done most of it, and the APPTs i'd want to process are clearly denoted from the plugin by the myItem.formdescriptin = "Project Web Appointment"
Keith –
I think I understand. You want to convert multiple-day appointments into single all-day appointments. I'll see what I can come up with.
JP, I haphazardly frankensteined your code and added what I needed and somehow got it to work …so far!
I'd be happy to share, it probably could use some cleaning up… and think it would needlessly make this thread longer in the comments.
JP,
I used the code and it works perfectly for now, but i would like to add a field that gives me the name of the calender owner. How can this be achieved ?
Next i tried to integrate the code written for Mary for collecting all calender items from different users into 1 excel sheet in an exchange 2003 environment, but was't able to get it working. Any thoughts on that one ?
If you are using GetSharedDefaultFolder to get someone else's Calendar, you have to know who that person is, because the method requires a Recipient object.
What do you mean "wasn't able to get it working"? You'll need to be more specific.
Wonderful Code JP,
Being this is my first week ever using VB i found it very helpful!
I used the original code you posted and then implemented various things throughout the posts like popup box for the dates and such. I have seen some people ask this before, but I dont know if an answer was really given yet.
What I am trying to do is when you run the macro I want it to search multiple personal (shared) calendars. I have gotten the code to work on defaults and on public items but only one calendar at a time.
Would it be possible to use an array that contains all the (peoples names) for the calendars that I want to search through? This whey you only have to run the macro once to pull information from say like 10 calendars.
Then if it would be possible post that persons name somewhere so we know whos information is what on the excelsheet.
Any help or point in the right direction would be awesome!
Great stuff, JP! Thanks for sharing.
Could it be modified to import Tasks into Excel?
Oops, nevermind. I found your "Export Outlook Tasks to Excel" blog. That did the trick perfectly! Thanks again.