Send Message on Behalf Question

  • Thread starter Thread starter Eka1618
  • Start date Start date
E

Eka1618

Hello,

I am programming a DB in Access and I am getting the Error message "A
Program is trying to send an e-mail message on your bealf..." This only
occurs when I send a message without editing it first. I am sending messages
using: DoCmd.sendobject. Many of the resolustion I've seen is for another
method. Is there anyway I can get rid of this message using the style I have
chosen? Below is a sample of my VB. If anyone know what I can do, please let
me know. Thank you!

~Erica~

Public Sub SendRequest(frm As Form)
Dim emName, emName2 As String, varItem As Variant
Dim emailBody As String
Dim emailSubject As String

emailSubject = "Product Test Request (Tech. Team Leader next action)"

On Error GoTo btnSend_Click_error

frm.REQUEST_NO.SetFocus
emailBody = "Hello, " & vbCrLf & vbCrLf & _
"A product test request has been issued for Request Number: " &
frm.REQUEST_NO.Text & "." & _
vbCrLf & vbCrLf & "Please log into the Product Engineering Test Database
to review this request to continue the process, Thank You!"

For Each varItem In frm!lboRequestee.ItemsSelected
emName = emName & Chr(34) & frm!lboRequestee.Column(2, varItem) &
Chr(34) & ","
Next varItem

For Each varItem In frm!lboRequestor.ItemsSelected
emName2 = emName2 & Chr(34) & frm!lboRequestor.Column(2, varItem) &
Chr(34) & ","
Next varItem

'remove the extra comma at the end
'add the requestor to the e-mail list recipients
emName2 = Left$(emName2, Len(emName2) - 1)
emName = Left$(emName, Len(emName) - 1)

'send message
frm.Visible = False
DoCmd.SendObject acSendNoObject, , , emName, emName2, , emailSubject,
emailBody, True, False

btnSend_Click_error:
If Err.Number = 2501 Then
MsgBox "You just canceled the e-mail", vbCritical, "Alert"
End If
End Sub
 
Thanks Andrei,

I actually found some code at Microsoft that talks about sending an HTML
formatted message. In it, there is an area that allows you to edit the 'FROM'
section of an e-mail message. The code that I have come up with seems to work
a little. I do not think that I am connecting to the server the right way.
The following is the code I've come up with. I do not get any errors, but the
e-mail does not send... If you know what I am doing wrong please let me know,
Thank you!

~Erica~

Private Sub btnAccept_Click()

' Send by connecting to port 25 of the SMTP server.
Dim iMsg
Dim iConf
Dim Flds
Dim strHTML
Dim emName As String, varItem As Variant
Dim emailBody As String


Const cdoSendUsingPort = 2

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

Set Flds = iConf.Fields

' Set the CDOSYS configuration fields to use port 25 on the SMTP server.

With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") =
cdoSendUsingPort
'ToDo: Enter name or IP address of remote SMTP server.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"mcg144.NTDOMAIN.COM"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =
25

..Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")
= 10
.Update
End With

Me.REQUEST_NO.SetFocus
emailBody = "Hello," & vbCrLf & vbCrLf & _
"The product test request for Request Number: " & REQUEST_NO.Text & _
" has been Accepted by the Tech Team Leader." & vbCrLf & vbCrLf & _
"To review the status of this product test request, " & _
"Please log into the Product Engineering Database, and view the status
on the Test Queue Screen." & vbCrLf & vbCrLf & _
"Thank You!"

' Apply the settings to the message.
' Build HTML for message body.
strHTML = "<HTML>"
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<b>" & emailBody & "</b></br>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"

If Me.lboRequestor.ItemsSelected.Count = 0 Then
MsgBox "Please select a test requestee"
Exit Sub
End If

For Each varItem In Me.lboRequestor.ItemsSelected
emName = emName & Chr(34) & lboRequestor.Column(2, varItem) & Chr(34) &
","
Next varItem

'remove the extra comma at the end
'add the requestor to the e-mail list recipients
emName = Left$(emName, Len(emName) - 1)

With iMsg
Set .Configuration = iConf
.To = emName 'ToDo: Enter a valid email address.
.From = "(e-mail address removed)" 'ToDo: Enter a valid email address.
.Subject = "Test Request Accepted (Requestor next action required)"
.HTMLBody = strHTML
.Send
End With

' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing

MsgBox "Mail Sent!"
 
If anyone using Access is having the same issue, I have found some code that
seems to work!

After many hrs of
searching, I have found and applied the following code to my DB. I changed
some things from the example I got the code from. In order to apply this code
to my DB, I had to add the Microsoft Outlook 12.0 reference. This code will
also solve the other problem that I was having which was formatting the
e-mail message using HTML (I just have not applied that yet).

In-any-event, I have tested the code out a couple times and it is sending
the e-mail without the error. If for some reason the message appears again, I
will tell my boss that purchacing a package like redemption is the best way
to go.

I got the example from the following site:
http://www.xtremevbtalk.com/showthread.php?t=76814

This is my code:

Public Sub SendEMail()
'Send an e-mail using the outlook application object...
'version 1.0
'1.0: Initial version.

Dim outOutlookInstance As Outlook.Application
Dim maiMessage As MailItem
Dim lngCounter As Long
Dim strArray() As String
Dim emName As String, varItem As Variant
Dim emailBody As String
Dim emailSubject As String

On Error GoTo SendEMail_Error

'Create the Outlook instance...
Set outOutlookInstance = CreateObject("Outlook.Application")

emailSubject = "Test Request Accepted (Requestor next action required)"

Me.REQUEST_NO.SetFocus

emailBody = "Hello," & vbCrLf & vbCrLf & _
"The product test request for Request Number: " & REQUEST_NO.Text & _
" has been Accepted by the Tech Team Leader." & vbCrLf & vbCrLf & _
"To review the status of this product test request, " & _
"Please log into the Product Engineering Database, and view the status
on the Test Queue Screen." & vbCrLf & vbCrLf & _
"Thank You!"

'Need to capture the requestee's e-mail address and assign it to the
..SentOnBehalfOfName

'Create the mail message...
Set maiMessage = outOutlookInstance.CreateItem(olMailItem)
With maiMessage
.To = "<[email protected]>"
.SentOnBehalfOfName = "<[email protected]>""
.subject = emailSubject
.body = emailBody

'Send the message...
.Send

End With

'Clear the objects...
Set maiMessage = Nothing
Set outOutlookInstance = Nothing


SendEMail_Error:
If Err.Number <> 0 Then
MsgBox Err.Number & ": " & Err.Description, vbCritical, "SendEMail"
End If

End Sub
 
Back
Top