Modify VBA to extract calendar date from outlook

Thanek

New Member
Joined
Apr 5, 2013
Messages
45
Here is a bit that I picked up from someone here. I'm trying to reference a public folder in Outlook and pull a date from a specific appointment. I can get this to work for my personal calendar but I cannot get the code right to reference the public calendar.

Code:
Sub GetApptsFromOutlook()
Application.ScreenUpdating = False
  Call GetCalData("4/1/2013", "4/30/13")
Application.ScreenUpdating = True
End Sub
 
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(olPublicFoldersAllPublicFolders).Folders("Public Folders\All Public Folders\Business\Bottling-Home")

Now I'm very green when it comes to VBA but I've messed around with the last line of this code in all sorts of ways and I still fail to get the object reference correct. I'm not sure if this has something to do with doing it from excel, offline, online, etc etc... I'm lost :(

Thanks for looking!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
So I figured out the specific ID number of the folder I was referencing taking it from...
Code:
Set myCalItems = olNS.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Public Folders\All Public Folders\Business\Bottling-Home")

To
Code:
Set myCalItems = olNS.GetFolderFromID("000000008DE72F48E3406B4FB50A50B93135256301000000335D345800D26C459ED4B2A336C41355").Items

That's all well and good now I'm trying to specify the specific appointment.
Code:
 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 = Range("A" & Rows.Count).End(xlUp).Row + 1
With rngStart
.Offset(NextRow, 1).Value = Format(ThisAppt.Start, "MM/DD/YYYY")
.Offset(NextRow, 0).Value = ThisAppt.Subject

I would like to set "MyItem" to the appointment subject but this is not working. Maybe I'm missing some "" or () or something?
 
Upvote 0

Forum statistics

Threads
1,207,421
Messages
6,078,436
Members
446,337
Latest member
nrijkers

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top