Opening outlook via Access2003 form

[StuJol]

Im using the following code to open the appointments window in outlook and
also transfer some data from a form into the appointment window.

This code only works if outlook is already open. Can some add some code
please to open outlook and to hide outlook.

I used the shell command when the form opened and set it to hide and it
worked fines the first time, but since the first time it wont work anymore

Thanks to anyone who looks at this for me

Private Sub cmdCreateAppt_Click()
'********************************************************************
' Name: cmdCreateAppt_Click
' Author: Arvin Meyer
' Date: June 10, 2004
' Comment: Set reference to Microsoft Outlook
'********************************************************************
On Error GoTo Err_cmdCreateAppt_Click

Dim objOl As Outlook.Application
Dim objItem As Outlook.AppointmentItem
Dim blnOlRunning As Boolean

On Error Resume Next

blnOlRunning = True

Set objOl = GetObject(, "Outlook.Application")

If Err <> 0 Then
Set objOl = CreateObject("Outlook.Application")
blnOlRunning = False
Err.Clear
End If

On Error GoTo 0

Set objItem = objOl.CreateItem(olAppointmentItem)

With objItem
.Start = CDate(Me.txtApptDate) + CDate(Me.txtApptTime)
.Duration = Me.txtDuration * Me.ogDuration
.Subject = Me.txtSubject & vbNullString
.Body = Me.txtBody & vbNullString

If Len(Me.txtReminder & vbNullString) > 0 Then
.ReminderSet = True
.ReminderMinutesBeforeStart = Me.txtReminder * Me.ogPeriod
Else
.ReminderMinutesBeforeStart = 0
.ReminderSet = False
End If

.Save
End With

If blnOlRunning = True Then
' display the new item
objItem.Display
Else
objOl.Quit
End If



Exit_cmdCreateAppt_Click:
Set objItem = Nothing
Set objOl = Nothing
Exit Sub


Err_cmdCreateAppt_Click:
Select Case Err

Case 0

Case Else
MsgBox Err.Description
Resume Exit_cmdCreateAppt_Click
End Select

End Sub

 

[David C. Holley]

Try this
Try this (Assuming you have Outlook in stalled on the PC running Access)

Function createOutlookAppointmentFromId(lngTransportId As Long)

Dim objOutlook As Object
Dim newAppt As Object
Dim lngPrimaryPassengerId As Long
Dim strPrimaryPassengerFirstName As String
Dim strPrimaryPassengerLastName As String
Dim rs As DAO.Recordset

Set objOutlook = CreateObject("Outlook.application")
Set newAppt = objOutlook.CreateItem(1)

With newAppt
.Start = glb_dteDate & " " & glb_dteTimeScheduled
.End = glb_dteDate & " " & DateAdd("h", 1,
CDate(glb_dteTimeScheduled))
.Subject = strPrimaryPassenger
.Location = glb_strOrigination & " - " & glb_strDestination
.Body = getBodyText(lngTransportId)
.BusyStatus = 2
If glb_dteDate < Now() Then
.ReminderSet = False
End If
.Categories = "Reservations"
.Save
createOutlookAppointmentFromId = newAppt.EntryID
End With

Set newAppt = Nothing
Set objOutlook = Nothing


End Function

 

[David C. Holley]

And to answer the question its probably because your're using GetObject
as opposed to CreateObject.