Hoi,
Ik ben bezig voor het werk met het maken van een database en wil gegevens uit de database automatisch in outlook agenda laten verschijnen. Ik heb volgende code op het internet gevonden maar ik krijg steeds de foutmelding: ongeldig gebruik van het sleutelwoord ME... Ik ken zelf niets van programmeertaal dus zou iemand me kunnen helpen? Alvast bedankt!
Ik ben bezig voor het werk met het maken van een database en wil gegevens uit de database automatisch in outlook agenda laten verschijnen. Ik heb volgende code op het internet gevonden maar ik krijg steeds de foutmelding: ongeldig gebruik van het sleutelwoord ME... Ik ken zelf niets van programmeertaal dus zou iemand me kunnen helpen? Alvast bedankt!
Code:
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.chkAddedToOutlook = 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 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) ' 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
'---------------------------------------------------------------------------------------
' Procedure : isAppThere
' Author : Rick Dobson, Ph.D - Programming Microsoft Access 2000
' Purpose : To check if an Application is Open
' Arguments : appName The name of the Application
' Example : isAppThere("Outlook.Application")
'---------------------------------------------------------------------------------------
'
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
Laatst bewerkt:
