Beste ik heb een goede code gevonden die access records pslaat in mijn outlook agenda. Deze code werkt uitstekend maar als outlook niet open staat zet hij de afspraak niet in Outlook: er komt onderaan wel een icoontje dat een programma verbinding maakt met outlook maar de afspraak zelf komt niet in de agenda. Iemand die dit probleem kan verhelpen? Hieronder vindt u de code:
Code:
Private Sub Outlook_Check()
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
Else
Dim olApp As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
If isAppThere("Outlook.Application") = False Then
Set outobj = CreateObject("Outlook.Application")
Else
Set olApp = GetObject(, "Outlook.Application")
End If
Set OutAppt = olApp.CreateItem(olAppointmentItem)
End Sub
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!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = _
Me!ApptLocation
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
Private Sub fraDuur_Click()
Dim iFactor As Long
iFactor = 1
Select Case fraduur
Case 1
iFactor = 1
Case 2
iFactor = 60
Case 3
iFactor = 24 * 60
Case 4
iFactor = 24 * 7 * 60
Case Else
End Select
Me.ReminderMinutes = Nz(Me.txtReminder, 0) * iFactor
Me.Repaint
End Sub
