Hi, I'm a novice when it comes to access programming and have so far edited some existing code to try and send my outlook records to the outlook diary. I'm not entirely sure if I did it correct, but after working around issues with IF blocks, I still have a 438 runtime error. Would be greatful if someone could look at my code and find my schoolboy errors.
In general it works with a push button and a check box to show if the record has already been added. There is a custom function that finds if outlook is open.
Thanks in advance.
Private Sub Send_diary_Click()
If Me.Dirty Then
Me.Dirty = False
End If
If Me.AddedToOutlook = True Then
MsgBox "This appointment has already added to Microsoft Outlook", vbCritical
' Exit the procedure
Exit Sub
Else
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
End If
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
' If There is no Start Date or Time on
' the Form use Nz to avoid an error
' Set the Start Property Value
.Start = Nz(Me.Start_Date, "")
' Set the End Property Value
.End = Nz(Me.Expiry_Date, "")
.Save
End With ' Release the Outlook object variables.
Set olappt = Nothing
Set olapp = Nothing ' Set chkAddedToOutlook to checked
Me.AddedToOutlook = True
' Save the Current Record because we checked chkAddedToOutlook
If Me.Dirty Then
Me.Dirty = False
End If
' Inform the user
MsgBox "Appointment Added!", vbInformation
On Error GoTo Send_diary_Click_Err
On Error Resume Next
DoCmd.GoToControl Screen.PreviousControl.Name
Err.Clear
DoCmd.RunCommand acCmdFind
If (MacroError <> 0) Then
Beep
MsgBox MacroError.Description, vbOKOnly, ""
End If
Send_diary_Click_Exit:
' Exit Function
Send_diary_Click_Err:
MsgBox Error$
Resume Send_diary_Click_Exit
End Sub
Function isAppThere(appName) As Boolean
On Error Resume Next
Dim objApp As Object
isAppThere = True
Set objApp = GetObject(, appName)
If Err.Number <> 0 Then isAppThere = False
End Function