• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 14228
  • Last Modified:

VBA to create Outlook Calendar Appointment

I have a Access project that I am using VBA to create Outlook Calendar Appointment.  The following code creates a new appointment in the defult Calendar window of MS Outlook.  Outlook allows you to create custom calendars under My Calendars.  Is there a way to modify the VBA to direct the new appointment to a custom calendar?  My calendar name is Project Schedule.

Ideas?
Bob

    Dim objOutlook As Outlook.Application
    Dim objAppt As Outlook.AppointmentItem
    Dim objRecurPattern As Outlook.RecurrencePattern
    Set objOutlook = CreateObject("Outlook.Application")
    Set objAppt = objOutlook.CreateItem(olAppointmentItem)
    With objAppt
        .Start = Me.datTargetStart
        .End = Me.datProjectedCompletion
        .Subject = Me.txtProjectName
        .Location = Me.cboSystem
        If Not IsNull(Me.txtProjectNotes) Then .Body = OutlookNotes
        .Save
        .Close (olSave)
    End With
    'Release the AppointmentItem object variable.
    Set objAppt = Nothing
0
RobertStamm
Asked:
RobertStamm
  • 4
  • 3
1 Solution
 
David LeeCommented:
Hi RobertStamm,

Sure, that's possible.  There are two solutions.  One, create the appointment in the default calendar then move it to the otehr calendar.  Two, create the appointment directly in the calendar.  Here's the modified code.

    Dim objOutlook As Outlook.Application
    Dim objCalendar As Outlook.MAPIFolder
    Dim objAppt As Outlook.AppointmentItem
    Dim objRecurPattern As Outlook.RecurrencePattern
    Set objOutlook = CreateObject("Outlook.Application")
    Set objCalendar = OpenMAPIFolder("\Mailbox - Doe, John\Project Schedule")
    Set objAppt = objCalendar.Items.Add
    With objAppt
        .Start = Me.datTargetStart
        .End = Me.datProjectedCompletion
        .Subject = Me.txtProjectName
        .Location = Me.cboSystem
        If Not IsNull(Me.txtProjectNotes) Then .Body = OutlookNotes
        .Save
        .Close (olSave)
    End With
    'Release the AppointmentItem object variable.
    Set objAppt = Nothing

'Credit where credit is due.
'The code below is not mine (well, a little of it is).  I found it somewhere on the
'internet but do not remember where or who the author is.  The original author(s)
'deserves all the credit for these functions.
Function OpenMAPIFolder(ByVal szPath As String)
    Dim app, ns, flr As MAPIFolder, szDir, i
    On Error GoTo errOMF
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        i = InStr(szPath, "\")
        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
    On Error GoTo 0
    Exit Function
errOMF:
    Set OpenMAPIFolder = Nothing
    On Error GoTo 0
End Function

Function IsNothing(Obj)
  If TypeName(Obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
'Macro Ends Here

Cheers!
0
 
RobertStammAuthor Commented:
BlueDevilFan,
This may be a dumb question but...this line has me confused.  I have this project as a FE/BE application with ~ 50 users.  My thoughts were that if I instructed everyone to create a "Project Schedule" calender, they could use it to seperate their appointments.  It looks to me that I will need to know their login name and code it into this line.  Not a problem, but is that correct?  Is the syntax correct?
 
Set objCalendar = OpenMAPIFolder("\Mailbox - Doe, John\Project Schedule")

I am capturing the users login name when they open my Access project.  Therefore my code would be modified as:

LoginID = LastName & ", " & FirstName
Set objCalendar = OpenMAPIFolder("\Mailbox - "  & LoginID & "\Project Schedule")

Thanks,
Bob

0
 
David LeeCommented:
> It looks to me that I will need to know their login name and code it into this line.  Not a problem, but is that correct?
If they create that calendar in their online mailbox, then that's correct.

> Is the syntax correct?
Looks right to me.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
RobertStammAuthor Commented:
BlueDevilFan,
I am getting a compile error.  I pasted your code into my project.  This last line highlights .Items and returns
"Method or data member not found."

    Dim objOutlook As Outlook.Application
    Dim objCalendar As Outlook.MAPIFolder
    Dim objAppt As Outlook.AppointmentItem
    Dim objRecurPattern As Outlook.RecurrencePattern
    Set objOutlook = CreateObject("Outlook.Application")
    Set objCalendar = OpenMAPIFolder("\Mailbox - Stamm,Bob\ProjectSchedule")
    Set objAppt = objCalendar.Items.Add

Ideas?
Thanks,
Bob
0
 
David LeeCommented:
Hmmm.  Every MAPIFolder object has an Items collection.  All I can suggest is setting a breakpoint on that last line and when the code breaks take a look at objCalendar.  Verify that it is of type MAPIFolder, and see if it contains an Items property.  
0
 
RobertStammAuthor Commented:
BlueDevilFan,
Thanks for your help.
Bpb
0
 
David LeeCommented:
You're welcome.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now