G
Guest
I'm using the following code to generate a meeting request from MS Access
app. Everything is fine except there is no To bar and no option to send the
request.
When I'm trying to use objItem.To = ... I'm getting an error that it's not
supported by this object.
Can anybody clarify how I could manage with it?
Public Function fnStartOutLook()
On Error GoTo StartOutLook_Error
Dim spObj As Object, objItem As Object
Dim strUser1 As String, strUser2 As String, strUser3 As String, strUser As
String
Dim dtStartDate As Date, dtEndDate As Date, dtStartTime As Date, dtEndTime
As Date
Dim myRequiredAttendee1 As Object
Dim myRequiredAttendee2 As Object
Dim myRequiredAttendee3 As Object
Dim strUserName As String
strUser = Environ$("username")
strUserName = fnUserName(strUser)
If IsNull(Forms!frmBP_InterviewSchedule.cboInterviewer) Or _
Forms!frmBP_InterviewSchedule.cboInterviewer = "" Then
MsgBox ("You should enter an Interviewer to set up a meeting.")
Exit Function
Else
strUser3 = Forms!frmBP_InterviewSchedule.cboInterviewer
End If
If IsNull(Me.cboInterviewee) Or (Me.cboInterviewee) = "" Then
MsgBox ("You should enter Interviewee #1 to set up a meeting.")
Exit Function
Else
strUser1 = Me.cboInterviewee
End If
If IsNull(Me.cboInterviewee2) Or (Me.cboInterviewee2) = "" Then
Else
strUser2 = Me.cboInterviewee2
End If
If (Not IsNull(Me.txtSelectDate)) And _
(IsNull(Me.txtMeetTime)) Then
MsgBox ("Once you entered the Date you should enter the Time as well to
set up a meeting.")
Exit Function
End If
If (IsNull(Me.txtSelectDate)) And _
(IsNull(Me.txtMeetTime)) Then
' MsgBox ("You should enter date and time to set up a meeting.")
Else
dtStartDate = Me.txtSelectDate
dtStartTime = Me.txtMeetTime
End If
' Create a Microsoft OutLook object.
'Set spObj = CreateObject("Outlook.Application")
Set spObj = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set spObj = CreateObject("Outlook.Application")
bStarted = True
End If
Set objItem = spObj.CreateItem(olAppointmentItem)
With objItem
.Subject = "The second level desktop-user interview"
If (IsNull(strUser3) Or (strUser3) = "") Or _
(LTrim(strUserName) = LTrim(strUser3)) Then
Else
Set myRequiredAttendee3 = .Recipients.Add(strUser3)
End If
If IsNull(strUser1) Or (strUser1) = "" Then
Else
Set myRequiredAttendee1 = .Recipients.Add(strUser1)
'.To = myRequiredAttendee1 ' the error message
End If
If IsNull(strUser2) Or (strUser2) = "" Then
Else
Set myRequiredAttendee2 = .Recipients.Add(strUser2)
'.To = myRequiredAttendee2 ' the error message
End If
If (IsNull(dtStartDate)) And _
(IsNull(dtStartTime)) Then
Else
.Start = dtStartDate & " " & dtStartTime
.End = DateAdd("h", 1, objItem.Start)
End If
objItem.Display
End With
On Error Resume Next
If bStarted Then
'If we started Outlook from code, then close it
spObj.Quit
End If
Set objItem = Nothing
Set spObj = Nothing
'Me.objOutlookFrame = Null
Exit Function
StartOutLook_Error:
MsgBox "Error: " & Err & " " & Error
Exit Function
End Function
app. Everything is fine except there is no To bar and no option to send the
request.
When I'm trying to use objItem.To = ... I'm getting an error that it's not
supported by this object.
Can anybody clarify how I could manage with it?
Public Function fnStartOutLook()
On Error GoTo StartOutLook_Error
Dim spObj As Object, objItem As Object
Dim strUser1 As String, strUser2 As String, strUser3 As String, strUser As
String
Dim dtStartDate As Date, dtEndDate As Date, dtStartTime As Date, dtEndTime
As Date
Dim myRequiredAttendee1 As Object
Dim myRequiredAttendee2 As Object
Dim myRequiredAttendee3 As Object
Dim strUserName As String
strUser = Environ$("username")
strUserName = fnUserName(strUser)
If IsNull(Forms!frmBP_InterviewSchedule.cboInterviewer) Or _
Forms!frmBP_InterviewSchedule.cboInterviewer = "" Then
MsgBox ("You should enter an Interviewer to set up a meeting.")
Exit Function
Else
strUser3 = Forms!frmBP_InterviewSchedule.cboInterviewer
End If
If IsNull(Me.cboInterviewee) Or (Me.cboInterviewee) = "" Then
MsgBox ("You should enter Interviewee #1 to set up a meeting.")
Exit Function
Else
strUser1 = Me.cboInterviewee
End If
If IsNull(Me.cboInterviewee2) Or (Me.cboInterviewee2) = "" Then
Else
strUser2 = Me.cboInterviewee2
End If
If (Not IsNull(Me.txtSelectDate)) And _
(IsNull(Me.txtMeetTime)) Then
MsgBox ("Once you entered the Date you should enter the Time as well to
set up a meeting.")
Exit Function
End If
If (IsNull(Me.txtSelectDate)) And _
(IsNull(Me.txtMeetTime)) Then
' MsgBox ("You should enter date and time to set up a meeting.")
Else
dtStartDate = Me.txtSelectDate
dtStartTime = Me.txtMeetTime
End If
' Create a Microsoft OutLook object.
'Set spObj = CreateObject("Outlook.Application")
Set spObj = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set spObj = CreateObject("Outlook.Application")
bStarted = True
End If
Set objItem = spObj.CreateItem(olAppointmentItem)
With objItem
.Subject = "The second level desktop-user interview"
If (IsNull(strUser3) Or (strUser3) = "") Or _
(LTrim(strUserName) = LTrim(strUser3)) Then
Else
Set myRequiredAttendee3 = .Recipients.Add(strUser3)
End If
If IsNull(strUser1) Or (strUser1) = "" Then
Else
Set myRequiredAttendee1 = .Recipients.Add(strUser1)
'.To = myRequiredAttendee1 ' the error message
End If
If IsNull(strUser2) Or (strUser2) = "" Then
Else
Set myRequiredAttendee2 = .Recipients.Add(strUser2)
'.To = myRequiredAttendee2 ' the error message
End If
If (IsNull(dtStartDate)) And _
(IsNull(dtStartTime)) Then
Else
.Start = dtStartDate & " " & dtStartTime
.End = DateAdd("h", 1, objItem.Start)
End If
objItem.Display
End With
On Error Resume Next
If bStarted Then
'If we started Outlook from code, then close it
spObj.Quit
End If
Set objItem = Nothing
Set spObj = Nothing
'Me.objOutlookFrame = Null
Exit Function
StartOutLook_Error:
MsgBox "Error: " & Err & " " & Error
Exit Function
End Function