Trying to send an E-mail on Your Behalf - Question

E

Eka1618

Hello,

I am trying to use some code that I got from Microsoft. I want to send an
e-mail without editing it first. I was using 'SendObject' but I got the error
message from outlook saying "A program is trying to send an e-mail on your
Behalf."

I researched this and I have now changed to a new method. When I use the new
code, I was getting an error about being unable to connect to the server,
then it went away. So now it seems as if my code works but it is skipping the
part where it sends the e-mail (the with iMsg loop). I do not know if I even
have the correct server name, and I am having a hard time trying to find out
what it is.

The following is my code:

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/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 has any suggestions on what do do please let me know. Also, I
would prefer to use my old method of 'SendObject', so if anyone knows how to
get rid on the "On Behalf" message using while using 'SendObject,' please let
me know, Thank You!
 
E

Eka1618

I am pretty sure that mcg144.NTDOMAIN.COM is the correct server name... I
found it in the setting for Microsoft Exchange Server. Is this the same as
"remote STMP server?"
 
E

Eka1618

I would need to purchace it, but I am trying to figure out an alternative
before telling my boss that they would need to purchace a program.

~Erica~
 
A

Arvin Meyer [MVP]

When I looked at the time it would take to try and set up an SMTP server,
then code and test, as opposed to simply installing the Redemption.DLL
(which has many other email features that I didn't use), there was no
question that the $200 which in my case was spread across 23 different
locations, each with a half dozen or so computers running this program,
there wasn't any question that my time cost more than buying the DLL. Since
you can download and try it for nothing, you might want to see how easy it
is.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com
 
E

Eka1618

Arvin,

I do appreciate the help. I ended up solving my problem. 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


Thanks Again!
 
D

Douglas J. Steele

I think "hack" is a bit strong, especially since you need to
install/register it on each workstation.
 
A

Arvin Meyer [MVP]

PeteCresswell said:
Reading the web page - I get the impression that, in bald terms, it's
basically a hack to defeat one or more Microsoft security patches.

Have I got it right?
Click to expand...

It's much more than that. There are many Outlook features that can be
addressed as well as the security prompts. For my purposes though, it makes
it easier to avoid the prompt.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

CDO Message 1
Seding fax using Right Fax, Fax Sr. 3
Send Message on Behalf Question 3
Did not receive email via CDO.message 1
Use HTML tags in e-mail Message 10
CDO Email Default Settings 5
Write Conflict Error solutions not helping... 8
Macro email 4

Top