shieldsco
asked on
Access - Application or Object - Defined Error
I receive run time error 287 Application or Object-Defined Error when trying to execute the following code - the error occurs on the .send line --- when I use .display the code executes fine and opens the email in the display mode, however I would like to send the email automactically --- Any thoughts on how to resolve the problem. Thanks
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Syst ems_Branch \Systems Metrics Database\Email\Email_6_Day s.xlsx"
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("t blEmail")
Do Until rs.EOF
If rs("email") & "" <> "" Then
varEmail = rs("email")
sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
End If
rs.MoveNext
Loop
sMail = Mid(sMail, 2)
Set objOutlook = CreateObject("Outlook.Appl ication")
Set objEmailMessage = objOutlook.CreateItem(0)
With objEmailMessage
.To = sMail
If strCC & "" <> "" Then
.CC = strCC
End If
.Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
.Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
.Attachments.Add xlPath
'.display
.send
End With
End Sub
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Syst
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("t
Do Until rs.EOF
If rs("email") & "" <> "" Then
varEmail = rs("email")
sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
End If
rs.MoveNext
Loop
sMail = Mid(sMail, 2)
Set objOutlook = CreateObject("Outlook.Appl
Set objEmailMessage = objOutlook.CreateItem(0)
With objEmailMessage
.To = sMail
If strCC & "" <> "" Then
.CC = strCC
End If
.Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
.Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
.Attachments.Add xlPath
'.display
.send
End With
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
what if you save it before .send?
correction
' place all the codes above here
should read
' place all the codes you posted above here, except the end sub
' place all the codes above here
should read
' place all the codes you posted above here, except the end sub
ASKER
Nothing happens
Not sure who you are responding to
ASKER
To Rey
pls. be explicit in your comment <Nothing happens >
are you still getting the error?
was the mail sent?, send it to your self so you will know.
are you still getting the error?
was the mail sent?, send it to your self so you will know.
His will just continue execution without displaying anything including the error. Did you try the the .save before the .send?
ASKER
Yes I'm saving before sending
ASKER
Rey - no error nor did it send the email
ASKER
Randy when I use the .save it goes to Draft folder
Try writing your concatenated string to the Immediate Window using a Debug.Print statement. Also, check that the file path and name is correct. You are using a variant to get the email addresses. It might be best to check whether there is an email in that field, and set a String variable to it if found, and go to the next record if not.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It sends to the Drafts Folder
Here's the code:
On Error GoTo SendError_Proc
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Syst ems_Branch \Systems Metrics Database\Email\Email_6_Day s.xlsx"
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("t blEmail")
Do Until rs.EOF
If rs("email") & "" <> "" Then
varEmail = rs("email")
sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
End If
rs.MoveNext
Loop
sMail = Mid(sMail, 2)
Set objOutlook = CreateObject("Outlook.Appl ication")
Set objEmailMessage = objOutlook.CreateItem(0)
With objEmailMessage
.To = sMail
If strCC & "" <> "" Then
.CC = strCC
End If
.Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
.Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
.Attachments.Add xlPath
'.display
.Save
.send
End With
'DoCmd.Quit
Exit_Send:
Exit Sub
SendError_Proc:
Select Case Err.Number
Case 287
Err.Clear
Resume Exit_Send
Case Else
MsgBox Err.Description
Resume Exit_Send
End Select
End Sub
Here's the code:
On Error GoTo SendError_Proc
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Syst
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("t
Do Until rs.EOF
If rs("email") & "" <> "" Then
varEmail = rs("email")
sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
End If
rs.MoveNext
Loop
sMail = Mid(sMail, 2)
Set objOutlook = CreateObject("Outlook.Appl
Set objEmailMessage = objOutlook.CreateItem(0)
With objEmailMessage
.To = sMail
If strCC & "" <> "" Then
.CC = strCC
End If
.Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
.Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
.Attachments.Add xlPath
'.display
.Save
.send
End With
'DoCmd.Quit
Exit_Send:
Exit Sub
SendError_Proc:
Select Case Err.Number
Case 287
Err.Clear
Resume Exit_Send
Case Else
MsgBox Err.Description
Resume Exit_Send
End Select
End Sub
From what I can see, outlook just does not have enough time to send the message. You would need to create global instances of the outlook app then initiate a timer and verify that the outbox is empty before continuing. That is why when you do display it works, gives the application time to send it.
ASKER
Ok I will try
ASKER
The code works as look as Outlook is not open
ASKER
I've requested that this question be closed as follows:
Accepted answer: 0 points for shieldsco's comment #a40219586
Assisted answer: 500 points for Rey Obrero's comment #a40219443
for the following reason:
Thanks Guys
Accepted answer: 0 points for shieldsco's comment #a40219586
Assisted answer: 500 points for Rey Obrero's comment #a40219443
for the following reason:
Thanks Guys
:-0 omg!!!
ASKER
Sorry about that - I split the points