Help Integrating Outlook Calendar with Continuous form

wrweaver

Registered User.
Local time
Today, 06:31
Joined
Feb 26, 2013
Messages
75
I have a continuous form for scheduling that I want to be able to add to the outlook calendar so I created a button with the following code:
(isappthere is a boolean function)
Dim myReply

myReply = MsgBox("Do you wish to add this appointment to your Outlook Calender", vbYesNo)
If myReply = vbYes Then

If Me.Dirty Then
Me.Dirty = False
End If

' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem

'early binding
'Dim olapp As Outlook.Application
'Dim olappt As Outlook.AppointmentItem
'Set olapp = CreateObject("Outlook.Application")
'Set olappt = olapp.createitem(olappointmentitem)

If isAppThere("Outlook.Application") = False Then
' Outlook is not open, create a new instance
Set olapp = CreateObject("Outlook.Application")
Else
' Outlook is already open--use this method
Set olapp = GetObject(, "Outlook.Application")
End If

Set olappt = olapp.createitem(1) ' (olappointmentitem)
With olappt
.start = Me.BeginDateTime
.End = Me.EndDateTime
.subject = "Worker Scheduled" & " " & Me.WorkerCombo.Column(1)
.body = Me.WorkerCombo.Column(1) & " " & Me.Notes

If IsNull(Me.WorkOrderID) Then
.location = DLookup("BuildingName", "WorkOrderQ", "WorkOrderID=" & Forms!ReviewWorkOrderF!WorkOrderID)
ElseIf Not IsNull(Me.WorkOrderID) Then
.location = (General)"
End If
.reminderminutesbeforestart = 60
.reminderset = True
.Save
End With

Set olappt = Nothing
Set olapp = Nothing

MsgBox "Appointment Added to Outlook!", vbInformation
ElseIf myReply = vbNo Then
Exit Sub
End If

The problem is the button only syncs the single record that is the focus. I want it to sync all the records displayed on the continuous form. Is this possible?

Thanks for the help!
 
Use the record source of the form as follows:
Code:
Private Sub btnAddAppointmentItems_Click()
On Error GoTo ErrHandler

    Dim rs As DAO.Recordset
    Set rs = Me.RecordsetClone

    If rs.RecordCount = 0 Then
        Exit Sub
    End If


    Dim olApp As Object
    Dim olAppt As Object

    If isAppThere("Outlook.Application") = False Then
        ' Outlook is not open, create a new instance
        Set olApp = CreateObject("Outlook.Application")
    Else
        ' Outlook is already open--use this method
        Set olApp = GetObject(, "Outlook.Application")
    End If
    
    
    Do
        Set olAppt = olApp.CreateItem(olAppointmentItem)
        
        With olAppt
            .Start = rs(0).Value
            .End = rs(1).Value
            .Subject = "Worker Scheduled" & " " & rs(2).Value
            .Body = rs(2).Value & " " & rs(3).Value
            ' ...
            ' ...
        End With
        
        Set olAppt = Nothing
        rs.MoveNext
    Loop While Not rs.EOF

Exit_Proc:
    Set rs = Nothing
    Set olApp = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description
    Resume Exit_Proc

End Sub

Please note you have to include some more fields to that record source because otherwise the values of combobox columns other than the bound ones (i.e. "Me.WorkerCombo.Column(1)") will not be accessible (or is Column(1) the bound one?).

And, of course, you have to get the corresponding recordset field values. In the example above I assumed "Me.BeginDateTime" is the value of the first recordset field ("rs(0).Value") for demonstration purposes only.
 
FYI:

I have seen this code floating around the web, and people seemingly take it as gospel:

Code:
If isAppThere("Outlook.Application") = False Then         ' Outlook is not open, create a new instance         
    Set olApp = CreateObject("Outlook.Application")     
Else         ' Outlook is already open--use this method         
    Set olApp = GetObject(, "Outlook.Application")     
End If
In fact

Code:
    Set olApp = CreateObject("Outlook.Application")
is perfectly adequate as replacement for the entire code above, because CreateObject is smart enough to know that only one instance of Outlook can be open at a time, so it Gets the open one, if there is one, or Creates one, if there isn't.
 
@StarGrabber:

I don't understand what your using as the record source for the form. Currently the record source is as follows:

SELECT * FROM ScheduleT WHERE BeginDateTime >= #3/30/2013#;

I changed the code to fit your model to the following:

On Error GoTo ErrHandler
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
If rs.RecordCount = 0 Then
Exit Sub
End If

Dim olApp As Object
Dim olAppt As Object
If isAppThere("Outlook.Application") = False Then
' Outlook is not open, create a new instance
Set olApp = CreateObject("Outlook.Application")
Else
' Outlook is already open--use this method
Set olApp = GetObject(, "Outlook.Application")
End If


Do
Set olAppt = olApp.CreateItem(1)

With olAppt
.Start = BeginDateTime.Value
.End = EndDateTime.Value
.Subject = "Worker Scheduled" & " " & WorkerID.Value
.Body = WorkerID.Value & " " & Notes.Value
' ...
' ...
End With

Set olAppt = Nothing
rs.MoveNext
Loop While Not rs.EOF
Exit_Proc:
Set rs = Nothing
Set olApp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume Exit_Proc

But when I click the button I get the message box that says "No current record."
 
My suggestion was your continuous form is bound to a table or query and displays at least one record. I tested the code before posting successfully so I'm sorry for the error MsgBox. Maybe the command rs.MoveFirst before starting the loop helps.

But... tell me, why do you use the control values instead of the recordset values?
Code:
With olAppt
    .Start = [COLOR=DarkRed]BeginDateTime.Value[/COLOR]
    .End = [COLOR=DarkRed]EndDateTime.Value[/COLOR]
    .Subject = "Worker Scheduled" & " " & [COLOR=DarkRed]WorkerID.Value[/COLOR]
    .Body = [COLOR=DarkRed]WorkerID.Value[/COLOR] & " " & [COLOR=DarkRed]Notes.Value[/COLOR]
    ' ...
    ' ...
End With
:confused:
 
Last edited:
I don't understand what you mean by recordset values.
 
If you want me to test your application you have to upload it complete, but with sample data naturally!
 
Ok, this time there are some data, but the application is still incomplete. "ReviewWorkOrderF" is missing. Anyway - I tried to get things running.

When I opened 'ScheduleF' I got a VBA syntax error at the last line of the procedure 'RequeryForm()' due to a different date format in my country. That's why I added some code. Delete it if you think it's unnecessary.

I don't understand why you put a form record source in the property window but override it with another record source set in 'RequeryForm()' which is called by the Form_Open event.

A bit better I understand the cause for the "No current record." message you mentioned in post # 4. I had it, too, but only after running the procedure twice. In order to prevent this message (but adding the same appointments again!) I put an additional If-block at the beginning of the procedure (If rs.EOF Then...). After stepping through all records in the loop it is logical the recordset has reached its End Of File!

I'm not sure if you really want to put 'WorkerID' (i.e. a number that says nothing) in the appointment subject and body. Therefore a DLookup provides the worker name now. If there isn't one, another DLookup retrieves the company name. If you don't like that, replace 'strWorkerName' by 'rs!WorkerID'.

In the actual code of "btnAddToOutlook_Click()" the recordset fields are referenced by their name and not by their indexes as shown in post # 2. Maybe this helps you to get into the matter of recordsets (search also the online help for 'DAO' and/or 'ADO'). I renamed the corresponding command button, "Command32" again says nothing!

My first tests were not successful. But the fourth was. Please don't ask me why, I don't have a clue. Access sometimes behaves like this. -- :o
 

Attachments

Last edited:
I wish I could click that Thank you button a million times! Thank you SO much StarGrabber! It works like a charm!
 
You are welcome!

Thanks for the feedback. There are some forum members who don't care to answer, regardless of whether the post was useful or not!
 
Do you know how to keep it from adding appointments that it has already added?
 
Sure! You are right, there should be a verification which prevents from adding duplicates. You'll find it in attached file.

Please note at this point I had to make some major code modifications. In order to not to bloat the module of 'ScheduleF' to much, I moved some code into the class module 'clsOutlook'. The function 'isAppThere' hasn't disappeared, it was moved to 'mdlUtilities'.

I took the liberty to delete your procedure "Notes_LostFocus()". I hope you don't mind.

And during some tests I noticed a deficiency: the subject didn't start with the right expression. Now it starts with "Worker" when it's a worker and with "Company" when it's a company. ;)
 

Attachments

It works in the sample but when I copy it into the real DB it gives me an error that says Variable not defined then in the debug sends me to the line

Set mOlCalendar = mOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)

and hightlights (olFolderCalendar).
 
I beg your pardon, wrweaver, I forgot to remove the VBA reference to the Outlook Library which I set for testing purposes.

Please replace 'olFolderCalendar' by '9'.
 

Users who are viewing this thread

Back
Top Bottom