MS-access >> agenda outlook

Status
Niet open voor verdere reacties.
J

JeroenMioch

Gebruiker
Lid geworden
1 dec 2007
Berichten
215
Ik probeer via mijn database Outlook agenda items te creeren.

Nou heb ik daar een stuk code voor opgespoord, maar ik loop tegen errors aan.

Het artikel waar één en ander in beschreven word staat hier :http://accesstips.wordpress.com/2008/09/03/from-access-to-outlook-add-custom-data-to-your-outlook-calendar/

Het eerste (en vermoedelijk niet het laatste) waar ik tegenaanloop is het stukje code waar word gecheckt of Oulook geopend is, of niet. En zo niet, dit alsnog doet.

Code: 
[COLOR="red"]Function IsAppThere("outlook.application") As Boolean[/COLOR]
On Error Resume Next
 
    Dim objApp As Object
 
    IsAppThere = True
    Set objApp = GetObject(, "outlook.application")
    If Err.Number <> 0 Then IsAppThere = False

End Function

Ik heb het idee dat het komt omdat outlook bij ons in de Novell omgeving staat, maar zeker weten doe ik het niet. Ik kan er ook nergens iets over terugvinden helaas.

Iemand idee wat er loos is ?
 
Ik snap de aanroep van de functie niet helemaal. Volgens mij moet dat zo:

Code: 
Function IsAppThere() As Boolean
On Error Resume Next
Dim objApp As Object
    IsAppThere = True
    Set objApp = GetObject(, "outlook.application")
    If Err.Number <> 0 Then IsAppThere = False
End Function
 
Hoi Michel, bedankt voor je reactie.

Ik krijg nu tenminste geen foutmelding meer in de functie, maar wel in de subprocedure, Heeft toch (denk ik) te maken dat hij "outlook.application" niet snapt :

Code: 
Private Sub btnAddApptToOutlook_Click()
'On Error GoTo ErrHandle
 
    Dim olNS As Object
    Dim olApptFldr As Object
 
    ' Save the Current Record
    If Me.Dirty Then Me.Dirty = False
 
    ' Exit the procedure if appointment has been added to Outlook.
    If Me.SLVafspraakOutlook = True Then
        MsgBox "This appointment has already added to Microsoft Outlook.", vbCritical
        Exit Sub
    Else
 
        ' Use late binding to avoid the "Reference" issue
        Dim olApp As Object        'Outlook.Application
        Dim olAppt As Object        'olAppointmentItem
 
        'This is how we would do it if we were using "early binding":
'        Dim olApp As Outlook.Application
'        Dim olappt As Outlook.AppointmentItem
'        Set olapp = CreateObject("Outlook.Application")
'        Set olappt = olapp.CreateItem(olAppointmentItem)
 
        If [COLOR="red"]IsAppThere[/COLOR]("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) ' 1 = olAppointmentItem
 
        ' Add the Form data to the Appointment Properties
        With olAppt
            If Nz(Me.chkAllDayEvent) = True Then
                .AllDayEvent = True
 
                ' Format the dates in the Form Controls
                Me.txtStartDate = FormatDateTime(Me.txtStartDate, vbShortDate)
                Me.txtEndDate = FormatDateTime(Me.txtEndDate, vbShortDate)
                ' For all day events use "" for the start time and the end time
                Me.cboStartTime = ""
                Me.cboEndTime = ""
 
                ' Get the Start and the End Dates
                Dim dteTempEnd As Date
                Dim dteStartDate As Date
                Dim dteEndDate As Date
                dteStartDate = CDate(FormatDateTime(Me.txtStartDate, vbShortDate)) ' Begining Date of appointment
                dteTempEnd = CDate(FormatDateTime(Me.txtEndDate, vbShortDate))      ' Use to compute End Date of appointment
 
                ' Add one day to dteEndDate so Outlook will set the number of days correctly
                dteEndDate = DateSerial(Year(dteTempEnd + 1), Month(dteTempEnd + 1), Day(dteTempEnd + 1))
 
                .Start = dteStartDate
                .End = dteEndDate
 
                ' Set the number of minutes for each day in the AllDayEvent Appointment
                Dim lngMinutes As Long
 
                lngMinutes = CDate(Nz(dteEndDate)) - CDate(Nz(dteStartDate))
                ' The duration in Minutes, 1440 per day
                lngMinutes = lngMinutes * 1440
 
                ' Add the minutes to the Access Form
                Me.txtApptLength.Value = lngMinutes
 
                .Duration = lngMinutes
 
            Else
                ' The Validation Rule for the Start Date TextBox requires a
                ' Start Date so there is no need to check for it here
                If Len(Me.cboStartTime & vbNullString) = 0 Then
                    ' There is no end time on the Form
                    ' Add vbNullString ("") to avoid an error
                    Me.cboStartTime = vbNullString
                End If
 
                ' Set the Start Property Value
                .Start = FormatDateTime(Me.txtStartDate, vbShortDate) _
                   & " " & FormatDateTime(Me.cboStartTime, vbShortTime)
 
                ' If there is no End Date on the Form just skip it
                If Len(Me.txtEndDate & vbNullString) > 0 Then
                    If Len(Me.cboEndTime & vbNullString) = 0 Then
                        ' There is no end time on the Form
                        ' Add vbNullString ("") to avoid an error
                        Me.cboEndTime = vbNullString
                    Else
                        ' Set the End Property Value
                        .End = FormatDateTime(Me.txtEndDate, vbShortDate) _
                           & " " & FormatDateTime(Me.cboEndTime, vbShortTime)
                    End If
                End If
 
                If Len(Me.txtApptLength & vbNullString) = 0 Then
                    Dim timStartTime As Date
                    Dim timEndTime As Date
 
                    ' Format the Start Time and End Time
                    timStartTime = FormatDateTime(Me.txtStartDate, vbShortDate) _
                           & " " & FormatDateTime(Me.cboStartTime, vbShortTime)
                    timEndTime = FormatDateTime(Me.txtEndDate, vbShortDate) _
                           & " " & FormatDateTime(Me.cboEndTime, vbShortTime)
 
                    .Duration = Me.txtApptLength
                End If
            End If
 
            If Nz(Me.chkAllDayEvent) = False Then
                .AllDayEvent = False
            End If
 
            If Len(Me.cboApptDescription & vbNullString) > 0 Then
                .Subject = Me.cboApptDescription
            End If
 
            If Len(Me.txtApptNotes & vbNullString) > 0 Then
                .Body = Me.txtApptNotes
            End If
 
            If Len(Me.txtLocation & vbNullString) > 0 Then
                .Location = Me.txtLocation
            End If
 
            If Me.chkApptReminder = True Then
                If IsNull(Me.txtReminderMinutes) Then
                    Me.txtReminderMinutes.Value = 30
                End If
                .ReminderOverrideDefault = True
                .ReminderMinutesBeforeStart = Me.txtReminderMinutes
                .ReminderSet = True
            End If
 
            ' Save the Appointment Item Properties
            .Save
        End With
 
        ' Set chkAddedToOutlook to checked
        Me.chkAddedToOutlook = True
 
        ' Save the Current Record because we checked chkAddedToOutlook
        If Me.Dirty Then Me.Dirty = False
 
        ' Inform the user
        MsgBox "New Outlook Appointment Has Been Added!", vbInformation
    End If
 
ExitHere:
    ' Release Memory
    Set olApptFldr = Nothing
    Set olNS = Nothing
    Set olAppt = Nothing
    Set olApp = Nothing
    Exit Sub
 
ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In procedure btnAddApptToOutlook_Click in Module Module1"
    Resume ExitHere
 
End Sub
 
Kijk, nu snap ik wat je eigenlijk doet met die code..... Blijkt toch dat je 'm verkeerd gebruikt overigens ;)

Code: 
Private Sub Knop8_Click()
MsgBox IsAppThere("Outlook.Application")
End Sub

Code: 
Function IsAppThere(App As String) As Boolean
On Error Resume Next
Dim objApp As Object
    IsAppThere = True
    Set objApp = GetObject(, App)
    If Err.Number <> 0 Then IsAppThere = False
End Function
 
Hoi Michel,

Ik begrijp even niet zo goed wat je met dat eerste stukkie code bedoelt, maar de tweede heb ik in de module gezet.
Ik krijg overigens nog steeds deze fout :

"Compileerfout, Er word een variabele of procedure verwacht, geen module" nog steeds op het punt die ik met rood aangaf in mn vorige post.
 
De eerste code is een voorbeeld hoe je de functie aanroept. In jouw oorspronkelijke code roep je met GetObject al rechtstreeks Outlook aan, maar je doet dat ook in de functie zelf door hem als startparameter te definiëren. Het is echter het één of het ander: of je gebruikt hem puur om Outlook te checken, of je maakt hem flexibel, zodat hij ook andere programma's kan controleren. Lijkt mij wat bruikbaarder :) Dus heb ik de GetObject aangepast; hij gebruikt nu de variabele die in de functie wordt meegegeven (App dus).
Omdat je nu een flexibele functie aanroept, moet je de waarde meegeven bij het aanroepen. In jouw geval zou dit dus moeten werken:

Code: 
     If IsAppThere("Outlook.Application") = False Then

Ik heb de code verder niet, dus ik heb er even een Msgbox van gemaakt om te zien of hij (in een Windows netwerk) wel werkt. En dat doet-ie. Ik heb geen idee of je hem anders aan moet roepen in Novell overigens.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan