J
Jim Jackson
I have a routine set to send Tasks through Outlook. All works well except
for the "Another program is attempting to send email..." message. Is there a
line of code I can add which will prevent this?
Private Sub cmdCreateTask_Click()
On Error GoTo Err_cmdCreateTask_Click
Dim objOl As Outlook.Application
Dim objItem As Outlook.TaskItem
Dim blnOlRunning As Boolean
Dim txtApptDate As Date
Dim Recipients As String
On Error Resume Next
blnOlRunning = True
Set objOl = GetObject(, "Outlook.Application")
'Stop
If Err <> 0 Then
Set objOl = CreateObject("Outlook.Application")
blnOlRunning = False
Err.Clear
End If
On Error GoTo 0
'Set objOutlookRecip = .Recipients.Add(stEmailAddress)
'stEmailAddress = (Addresses)
'Set objItem = objOl.CreateItem(olTasktItem)
Set objItem = objOl.CreateItem(olTaskItem)
With objItem
.Owner = Me.Addresses
.Subject = Me.txtSubject & vbNullString
.Body = Me.txtBody & vbNullString
.Recipients.Add (Me.Addresses) & ";" & (Me.Address2)
.DueDate = Me.txtApptDate
.startdate = Me.txtApptDate
' Stop
'If Len(Me.txtReminder & vbNullString) > 0 Then
' .ReminderSet = True
' .ReminderMinutesBeforeStart = Me.txtReminder * Me.ogPeriod
'Else
' .ReminderMinutesBeforeStart = 0
' .ReminderSet = False
'End If
.Save
End With
'Stop
If blnOlRunning = True Then
' display the new item
objItem.Display
objItem.Assign
objItem.Send
' DoCmd.SendObject , (objItem) ', , (Me.Addresses), , , _
(Me.txtSubject), (Me.txtBody), True
Else
objOl.Quit
End If
Exit_cmdCreateTask_Click:
Set objItem = Nothing
Set objOl = Nothing
Exit Sub
Err_cmdCreateTask_Click:
Select Case Err
Case 0
Case Else
MsgBox Err.Description
Resume Exit_cmdCreateTask_Click
End Select
End Sub
Thanks,
Jim
for the "Another program is attempting to send email..." message. Is there a
line of code I can add which will prevent this?
Private Sub cmdCreateTask_Click()
On Error GoTo Err_cmdCreateTask_Click
Dim objOl As Outlook.Application
Dim objItem As Outlook.TaskItem
Dim blnOlRunning As Boolean
Dim txtApptDate As Date
Dim Recipients As String
On Error Resume Next
blnOlRunning = True
Set objOl = GetObject(, "Outlook.Application")
'Stop
If Err <> 0 Then
Set objOl = CreateObject("Outlook.Application")
blnOlRunning = False
Err.Clear
End If
On Error GoTo 0
'Set objOutlookRecip = .Recipients.Add(stEmailAddress)
'stEmailAddress = (Addresses)
'Set objItem = objOl.CreateItem(olTasktItem)
Set objItem = objOl.CreateItem(olTaskItem)
With objItem
.Owner = Me.Addresses
.Subject = Me.txtSubject & vbNullString
.Body = Me.txtBody & vbNullString
.Recipients.Add (Me.Addresses) & ";" & (Me.Address2)
.DueDate = Me.txtApptDate
.startdate = Me.txtApptDate
' Stop
'If Len(Me.txtReminder & vbNullString) > 0 Then
' .ReminderSet = True
' .ReminderMinutesBeforeStart = Me.txtReminder * Me.ogPeriod
'Else
' .ReminderMinutesBeforeStart = 0
' .ReminderSet = False
'End If
.Save
End With
'Stop
If blnOlRunning = True Then
' display the new item
objItem.Display
objItem.Assign
objItem.Send
' DoCmd.SendObject , (objItem) ', , (Me.Addresses), , , _
(Me.txtSubject), (Me.txtBody), True
Else
objOl.Quit
End If
Exit_cmdCreateTask_Click:
Set objItem = Nothing
Set objOl = Nothing
Exit Sub
Err_cmdCreateTask_Click:
Select Case Err
Case 0
Case Else
MsgBox Err.Description
Resume Exit_cmdCreateTask_Click
End Select
End Sub
Thanks,
Jim