J
James Bond
Hello,
I have written an Function:
Public Function MakeAppointment(strOutlookFolderID As String, strSubject As
String, datDatum As Date, strLocation As String, strBody As String,
bolAllDay As Boolean, Optional strvon As String, Optional strbis As String,
Optional strOutlook As String) As String
5 On Error GoTo Handler
Dim olfolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.NameSpace
Dim myStoreID As String
10 Set olApp = CreateObject("Outlook.Application")
15 Set olns = olApp.GetNamespace("MAPI")
20 olns.Logon , , False, False
25 Set olfolder = olns.GetFolderFromID(strOutlookFolderID)
30 If Nz(strOutlook) = "" Then
35 Set objAppt = olfolder.Items.Add
40 Else
45 myStoreID = olfolder.StoreID
50 Set objAppt = olns.GetItemFromID(strOutlook, myStoreID)
55 End If
60 With objAppt
65 .Subject = strSubject
70 If Nz(Trim(strLocation)) <> "" Then
75 .Location = strLocation
80 End If
85 If bolAllDay = False Then
90 .start = CDate(datDatum & " " & strvon & ":00")
95 .End = CDate(datDatum & " " & strbis & ":00")
100 .AllDayEvent = False
105 Else
110 .start = datDatum
115 .AllDayEvent = True
120 End If
'recurring appointment
'.IsRecurring
125 .ReminderSet = False
130 .Body = strBody
'.Importance = olImportanceHigh
135 .Save
140 MakeAppointment = .EntryID
145 End With
150 olns.Logoff
155 Set objAppt = Nothing
160 Set olfolder = Nothing
165 Set olns = Nothing
170 Set olApp = Nothing
175 Exit Function
Handler:
Msgbox err.Number & vbnewline & err.Description
End Function
Sometimes I get an error in line 50, 25. I dont know why.
I think the IDs are right.
MFG
James
I have written an Function:
Public Function MakeAppointment(strOutlookFolderID As String, strSubject As
String, datDatum As Date, strLocation As String, strBody As String,
bolAllDay As Boolean, Optional strvon As String, Optional strbis As String,
Optional strOutlook As String) As String
5 On Error GoTo Handler
Dim olfolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.NameSpace
Dim myStoreID As String
10 Set olApp = CreateObject("Outlook.Application")
15 Set olns = olApp.GetNamespace("MAPI")
20 olns.Logon , , False, False
25 Set olfolder = olns.GetFolderFromID(strOutlookFolderID)
30 If Nz(strOutlook) = "" Then
35 Set objAppt = olfolder.Items.Add
40 Else
45 myStoreID = olfolder.StoreID
50 Set objAppt = olns.GetItemFromID(strOutlook, myStoreID)
55 End If
60 With objAppt
65 .Subject = strSubject
70 If Nz(Trim(strLocation)) <> "" Then
75 .Location = strLocation
80 End If
85 If bolAllDay = False Then
90 .start = CDate(datDatum & " " & strvon & ":00")
95 .End = CDate(datDatum & " " & strbis & ":00")
100 .AllDayEvent = False
105 Else
110 .start = datDatum
115 .AllDayEvent = True
120 End If
'recurring appointment
'.IsRecurring
125 .ReminderSet = False
130 .Body = strBody
'.Importance = olImportanceHigh
135 .Save
140 MakeAppointment = .EntryID
145 End With
150 olns.Logoff
155 Set objAppt = Nothing
160 Set olfolder = Nothing
165 Set olns = Nothing
170 Set olApp = Nothing
175 Exit Function
Handler:
Msgbox err.Number & vbnewline & err.Description
End Function
Sometimes I get an error in line 50, 25. I dont know why.
I think the IDs are right.
MFG
James