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.
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/information-technology/9522-send-mail-office-xp-without-warnings.html
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
'
are not empty or null>
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM
WHERE ",
CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
Do Until rs.EOF
Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)
EmailAddr = rs(0)
'CopyEmailAddr =
Subj =
Body =
PathName =
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:
'
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
--
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/showthread.php?t=9522
A $300 dollar picture tube will protect a 10 cent fuse by blowing first-
Murphy
Message posted via http://www.accessmonster.com
Our Donation Goal
: Why Donate? : Donate Today! : Donate Anonymously (ਗੁਪਤ) : Our Family of Supporters 
Linear Mode
