Send mail in Office XP WITHOUT warnings: the 99% solution

[serviceman via AccessMonster.com]

Ok gang,
I've been getting wonderful advice and tips from this site, and now I have
something to give back (maybe!):
The following script to send a single email was found on an MSDN tech page,
but for the life of me I can't find the link (damned that delete history
button! ) I added the loop portion and changed the file lookup for
attachments a bit.
The following code will loop through a query and send an email to each email
address WITHOUT ANY SECURITY WARNINGS. This apparently works only with Office
XP...

HOWEVER.... (Knew that was coming, right?)
The script relies on the dreaded sendkeys command to send each email, and of
course it is a bit Kludgey...
The only issues I've seen with this script is the sendkey problems below:
1) Sendkeys absolutely hates Word as the editor. It will work 1 in 10 times.
2) When outlook is not using Word as the editor, all but the last email seem
to send 90% of the time, and the other 10% of the time it works fine. Why it
doesn't send the keystrokes to the last email is beyond me.

If anyone can come up with a fix for the sendkey portion, This will probably
be a very useful piece of code!

This is written using ADODB (we're on SQL server) but can use DAO recordset
as well. At present I have a form with text fields for subject,message, and
file path to attach that I pass in, and the email addresses are passed in
from the 1st query column (rs(0)).

Private Sub Command0_Click()
On Error GoTo Err_Command0_Click

Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
Dim rs As ADODB.Recordset
'<Insert ISNULL or IF statements here to make sure subject,message and query
are not empty or null>
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM <your table> WHERE <your filter criteria>",
CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs

Do Until rs.EOF


Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)

EmailAddr = rs(0)
'CopyEmailAddr = <whatever field you want to pass>
Subj = <whatever field you want to pass>
Body = <whatever field you want to pass>
PathName = <whateverfield you want to pass>

With objMail
.To = EmailAddr
.cc = CopyEmailAddr
.Subject = Subj
.Body = Body
.NoAging = True
If IsNull(PathName) = False Then
.Attachments.Add PathName
End If
.Display
End With
'Here is the problem area
SendKeys "%{s}", True 'send the email without prompts
'End of problem area
rs.MoveNext

Loop

Set objMail = Nothing
Set objOutlook = Nothing
End With
Exit_Command0_Click:
Exit Sub

Err_Command0_Click:
'<I took out some custom error msgs unique to my app here>
MsgBox Err.Description
End If
Resume Exit_Command0_Click

End Sub

If anyone can add to this, post it here so we can all benefit (me too!).

Andy

 

[Guest]

This is a way to avoid outlook and the sendkey and uses cdo. There are
limitations with operating systems. I know XP is OK, but I forget the rest
off the top of my head. Microsoft has more information about using this
method.

Const cdoSendUsingPort = 2
Const cdoBasic = 1
Dim objCDOConfig As Object, objCDOMessage As Object
Dim strSch As String


strSch = "http://schemas.microsoft.com/cdo/configuration/"
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item(strSch & "sendusing") = cdoSendUsingPort
.Item(strSch & "smtpserver") = "ExchangeServerName"

.Item(strSch & "SMTPAuthenticate") = cdoBasic
.Item(strSch & "SendUserName") = "(e-mail address removed)"
.Item(strSch & "SendPassword") = "AccountPassword"
.Update
End With


Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.FROM = "User"
.Sender = "User"
.To = SendTo
.Cc = SendCc
.Subject = SendSubject
.TextBody = SendBody
If Len(SendAttachment) > 0 Then
.AddAttachment SendAttachment
End If
.Send
End With
Set objCDOMessage = Nothing
Set objCDOConfig = Nothing

 

[Danny J. Lesandrini]

Try JMail ...

http://amazecreations.com/datafast/GetFile.aspx?file=A97Jmail.zip

 

[serviceman via AccessMonster.com]

Hey schasteen,
Yup, that works fine with an SMTP server environment; What I posted is set up
to work with your regular email client on the workstation if no SMTP server
is available. It would be nice if Microsoft would get their head out or their
keester and allow security functionality to be configured (Exchange allows
the admin to turn off those warnings), but that is a pipe dream for sure...
Andy

This is a way to avoid outlook and the sendkey and uses cdo. There are
limitations with operating systems. I know XP is OK, but I forget the rest
off the top of my head. Microsoft has more information about using this
method.

Const cdoSendUsingPort = 2
Const cdoBasic = 1
Dim objCDOConfig As Object, objCDOMessage As Object
Dim strSch As String

strSch = "http://schemas.microsoft.com/cdo/configuration/"
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item(strSch & "sendusing") = cdoSendUsingPort
.Item(strSch & "smtpserver") = "ExchangeServerName"

.Item(strSch & "SMTPAuthenticate") = cdoBasic
.Item(strSch & "SendUserName") = "(e-mail address removed)"
.Item(strSch & "SendPassword") = "AccountPassword"
.Update
End With

Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.FROM = "User"
.Sender = "User"
.To = SendTo
.Cc = SendCc
.Subject = SendSubject
.TextBody = SendBody
If Len(SendAttachment) > 0 Then
.AddAttachment SendAttachment
End If
.Send
End With
Set objCDOMessage = Nothing
Set objCDOConfig = Nothing

Ok gang,
I've been getting wonderful advice and tips from this site, and now I have

[quoted text clipped - 83 lines]

Andy