Access db to Outlook calendar

[cruzpatas]

I have an Access DB that is used by multiple users. I have set it up to link the appointments to my default Outlook calendar, but would like to allow any user in the DB to be able to send it to a nondefault created Calendar that we all share.
Here is my current code. I have tried several other threads' ideas without any success.

The shared Calendar is named BloodDrives.

Private Sub AddAppt_Click()
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedtoOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt


.Start = Me!DriveDate & " " & Me!StartTime
.Duration = Me!DriveDurationMinutes
.Subject = Me!ClubName
If Not IsNull(Me!DriveType) Then .Body = Me!DriveType
If Not IsNull(Me!DriveLocation) Then .Location = _
Me!DriveLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedtoOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub

 

[cruzpatas]

I have added this bit froma post by darbid

Else
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)
strName = Me!Assigned_to.Value
With outappt

but it still goes back to my default calendar and not the BloodDrives calendar, how do I designate it to do so?

 

[darbid]

Hi cruz,

I assume you mean this post?

Could you please post your full sub addappt() as it now is. Could you post it in code brackets (see the little button # when typing). Could you also set out you code a little better to read it.

Also could you please test some things. From the Outlook that you are running this code could you manually withOUT code check you can view this calendar, also that you can make an appointment on behalf of this account in this calendar, also that you can delete the appointment too.

If this is ok then in your code delete any ON Error Resume Next lines and then run your code and tell me on which line it errors.


set out code like this (i just cut and copied some code to show you how to set out)

Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)

With outappt
      .Start = Me!DriveDate & " " & Me!StartTime
      .Duration = Me!DriveDurationMinutes
      .Subject = Me!ClubName

      If Not IsNull(Me!DriveType) Then .Body = Me!DriveType

            If Not IsNull(Me!DriveLocation) Then .Location = _

                  Me!DriveLocation

                        If Me!ApptReminder Then
                              .ReminderMinutesBeforeStart = Me!ReminderMinutes
                              .ReminderSet = True
                        End If

                  .Save

            End If

      End If

End With

 

[cruzpatas]

Yes this post.

Thank for the help!

I have access to and owner permissions on the BloodDrives Calendar (not my default). My secretary and few others also have those permissions and can view, add and edit. We all use the same Access DB front end and I will be sharing the Blood Drives Calendar with them from my Outlook.

I have attempted to do as you asked. Some of the boxes that appeared while I was typing didn't have an option that would work, so I left it alone. I may not understand the boxes well enought to use them effectively. This code as it is works well to add the "appt" to my default calendar, now I'm trying to make it go to the shared one.

Private Sub AddAppt_Click()

' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

' Exit the procedure if appointment has been added to Outlook.
If Me!AddedtoOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"

Exit Sub

' Add a new appointment.

Else
Dim ObjFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
strName = Me!AssignedTo.Value

With outappt
.Start = Me!DriveDate & " " & Me!StartTime
.Duration = Me!DriveDurationMinutes
.Subject = Me!ClubName

If Not IsNull(Me!DriveType) Then .Body = Me!DriveType

If Not IsNull(Me!DriveLocation) Then .Location = _
Me!DriveLocation

If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True

End If

.Save

End With

End If

' Release the Outlook object variable.
Set outobj = Nothing

' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedtoOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"

Exit Sub

AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description

Exit Sub

End Sub

 

[darbid]

You need to understand this post from the other thread you just posted in. Strname is the email address of your shared folder.

http://www.access-programmers.co.uk/forums/showpost.php?p=1066289&postcount=4

 

[cruzpatas]

I get a runtime error 424. Ok I have been looking at several posts and trying to get the idea of this. When i have my curser over the strName the email address comes up, but when i put it over objRecip I get = nothing.

Else
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
strName = "myemail@bob.edu"
Set objRecip = objNS.CreateRecipient(strName)
Set outobj = CreateObject("outlook.application")
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar
Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)

With outappt

 

[darbid]

Else
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

strName = "myemail@bob.edu"
Set outobj = CreateObject("outlook.application")
Set objNS = outobj.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar
Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)

With outappt

This looks better, you need namespace in there.

 

[cruzpatas]

Has anyone told you that you are great!!!!

424 Error in red line it comes up as (Application=1) whne moused.

Not sure when we need to look at this. When this gets going, ibelieve it will go to my default calendar. I am going to need it to go to a created calendar in my outlook.

Else
Dim obNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem


strName = "chris.tarver@ololrmc.com"
Set outobj = CreateObject("outlook.application")
Set objNS = outobj.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)
With outappt

 

[darbid]

The line in red needs to be deleted.

and objAppt is now your calendar item.

 

[cruzpatas]

Ok this is where I am now. I have it to where I and others that have permission to my main default calendar (ChrisCalendar) can add the appt. Now the question is to how do I designate that appt to a created calendar that is in My Calendars Folder that will be shared. My main Calendar is named ChrisCalendar and I want it to go to the one named Blood Drives that will be shared with most employees. I would imagine I have to assign it to that calendar, but cant figure out what to change or add. Here is the code that is currently working great.

Private Sub AddAppt_Click()

' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

' Exit the procedure if appointment has been added to Outlook.
If Me!AddedtoOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"

Exit Sub

' Add a new appointment.

Else
Dim obNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim objAppt As Outlook.AppointmentItem
Dim objApp As Outlook.Application
Dim outobj As Outlook.Application


strName = "myemail@bob.edu"

Set objApp = CreateObject("Outlook.Application")
Set outobj = CreateObject("outlook.application")
Set objNS = outobj.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add


With objAppt

.Start = Me!DriveDate & " " & Me!StartTime
.Duration = Me!DriveDurationMinutes
.Subject = Me!ClubName

If Not IsNull(Me!DriveType) Then .Body = Me!DriveType

If Not IsNull(Me!DriveLocation) Then .Location = _
Me!DriveLocation

If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True

End If

.Save

End With

End If

' Release the Outlook object variable.
Set outobj = Nothing

' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedtoOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"

Exit Sub

AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description

Exit Sub

End Sub

 

[cruzpatas]

Here is my attempt at retrieving the BlodDrive folder and setting the appt in it. I get a error 438 and the following line is highlighted.

Else


Dim obNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim objAppt As Outlook.AppointmentItem
Dim objApp As Outlook.Application
Dim outobj As Outlook.Application
Dim fldrName As String

strName = "chris.tarver@ololrmc.com"
fldrName = "BloodDrives"

Set objApp = CreateObject("Outlook.Application")
Set outobj = CreateObject("outlook.application")
Set objNS = outobj.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set bdFolder = objFolder.GetSharedDefaultFolder(fldrName)
Set objAppt = bdFolder.Items.Add


With objAppt

 

[darbid]

Ok this is where I am now. I have it to where I and others that have permission to my main default calendar (ChrisCalendar) can add the appt. Now the question is to how do I designate that appt to a created calendar that is in My Calendars Folder that will be shared. My main Calendar is named ChrisCalendar and I want it to go to the one named Blood Drives that will be shared with most employees. I would imagine I have to assign it to that calendar, but cant figure out what to change or add. Here is the code that is currently working great.

I have a feeling you are not going to like this, but my answer is I do not know how to do what you want. This is because folder structures can be unique to your setup and sometimes are not available.

So here is what I would do.

First I would look at what is returned by the GetSharedDefaultFolder function. see here http://msdn.microsoft.com/en-gb/library/aa220116(office.11).aspx it says that it returns a MAPIFolder - (Whatever that is) so I clicked on that cause they have a hyperlink and I get to here http://msdn.microsoft.com/en-gb/library/aa210948(office.11).aspx

This means that your objFolder is a MAPIFolder. So if you put objFolder. (Notice the dot there) intelliscense will give you a lot of options. You think what the hell does that mean. Well......

Now I go down to the properties of this MAPIFolder on the web page. You can see that one property is Folders (This will also be in the list from intelliscense) http://msdn.microsoft.com/en-gb/library/aa212017(office.11).aspx . This will return all the folders under your MAPIFolder. ie all your sharedcalendar folders.

Now the last step is to get from this Folders to your folder. This is where you need to work this out yourself, because from memory there is no nice function GetMeShareFolderNamed("BlodDrive") what you have to do is loop through the Folders and find the one you want.

But first try this from here you can see http://msdn.microsoft.com/en-gb/library/aa210918(office.11).aspx

Use Folders(index), where index is the name or index number, to return a single MAPIFolder object. Folder names are case-sensitive.

So maybe Folders("blodDrive") might give you the folder.

So DO NOT CUT and copy this cause it will never work but you are working towards something like this

Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set bdFolder = objFolder.Folders(fldrName)

I am pretty sure Outlook has a problem with this cause it is a non default calendar but I might be wrong.

Next you would have to loop through all your folders.

Dim olTempFolder as Outlook.MAPIFolder

Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
for each  olTempFolder in objFolder
  debug.print olTempFolder.Name
next

In this loop it should show you the names of all folders, and one of this will be the one you want. So you need to do an IF in there and get the folder with the right name. I am intentionally leaving that up to you.

 

[cruzpatas]

I had a bad sickness hit end of last week. I am getting back to this now. I am going to look over it. Thanks