Need help automating emails with Outlook

[Brossyg]

I have some VBA code that creates an email in Access and sends it from
Outlook. It is based on a query with a list of email addresses. It sends the
first email to Outlook and then I have to manually click the SEND button in
Outlook ... and then the second email is sent to Outlook ... and so on...

The list of email addresses is getting quite long and I want to automate
clicking the SEND button in Outlook from the VBA script...but don't know how!

Here is the VB code currently that works perfectly as long as I manually
click the SEND button in Outlook for each email:

Dim counter As Integer
Dim origemailstosend As Integer

counter = 1
origemailstosend = Me![totalemails]

While counter <= origemailstosend

DoCmd.SendObject _
, _
, _
, _
[eMailclean], _
, _
"(e-mail address removed)", _
"Thank you for your purchase!", _
"Thank you for your purchase of the Money Matters handout and
bible study series." & Chr(13) & Chr(13) & "Your Username is: " &
[Acct_Number] & Chr(13) & "Your Password is: " & [ZipCode] & Chr(13) &
Chr(13) & "Please go to www.ourcompany.org and click on the Stewardship
Download Center to download your Money Matters files." & Chr(13) & Chr(13) &
"Sincerely," & Chr(13) & Chr(13) & "Customer Service" & Chr(13) & "our
company", _
True

Me![totalemails] = Me![totalemails] - 1
Requery
counter = counter + 1
Wend

DoCmd.Close

What I need to know is how to programatically click the SEND button in
Outlook in the VBA code, or another way to release the email so the WEND can
continue to loop without manually clicking the SEND button.

Or, is there a way to change Outlook to send/receive every second instead of
every minute (minimum normally).

Thanks for any help.

 

[Danny Lesandrini]

Using your code, you simply have to change the last parameter from True to False.

True applies to the parameter [Edit Message], which pops it open. Set that to False
and it will send on it's own.

 

[Brossyg]

Thanks...that was easy...I will try it!

Using your code, you simply have to change the last parameter from True to False.

True applies to the parameter [Edit Message], which pops it open. Set that to False
and it will send on it's own.

--
Danny J Lesandrini
(e-mail address removed)
www.amazecreations.com

I have some VBA code that creates an email in Access and sends it from
Outlook. It is based on a query with a list of email addresses. It sends the
first email to Outlook and then I have to manually click the SEND button in
Outlook ... and then the second email is sent to Outlook ... and so on...

The list of email addresses is getting quite long and I want to automate
clicking the SEND button in Outlook from the VBA script...but don't know how!

Here is the VB code currently that works perfectly as long as I manually
click the SEND button in Outlook for each email:

Dim counter As Integer
Dim origemailstosend As Integer

counter = 1
origemailstosend = Me![totalemails]

While counter <= origemailstosend

DoCmd.SendObject _
, _
, _
, _
[eMailclean], _
, _
"(e-mail address removed)", _
"Thank you for your purchase!", _
"Thank you for your purchase of the Money Matters handout and
bible study series." & Chr(13) & Chr(13) & "Your Username is: " &
[Acct_Number] & Chr(13) & "Your Password is: " & [ZipCode] & Chr(13) &
Chr(13) & "Please go to www.ourcompany.org and click on the Stewardship
Download Center to download your Money Matters files." & Chr(13) & Chr(13) &
"Sincerely," & Chr(13) & Chr(13) & "Customer Service" & Chr(13) & "our
company", _
True

Me![totalemails] = Me![totalemails] - 1
Requery
counter = counter + 1
Wend

DoCmd.Close

What I need to know is how to programatically click the SEND button in
Outlook in the VBA code, or another way to release the email so the WEND can
continue to loop without manually clicking the SEND button.

Or, is there a way to change Outlook to send/receive every second instead of
every minute (minimum normally).

Thanks for any help.

 

[Brossyg]

I tried your suggestion changing the edit parametrer to false. Now, as the
emails cue up to Outlook, I get the message "A program is trying to
automatically send email on your behalf. Do you want to allow this?" So,
instead of hitting "SEND" each time, I now have to hit "YES" each time. Is
there a way to turn this warning off so the emails go out without having to
hit "YES" to the warning each time?

Using your code, you simply have to change the last parameter from True to False.

True applies to the parameter [Edit Message], which pops it open. Set that to False
and it will send on it's own.

--
Danny J Lesandrini
(e-mail address removed)
www.amazecreations.com

I have some VBA code that creates an email in Access and sends it from
Outlook. It is based on a query with a list of email addresses. It sends the
first email to Outlook and then I have to manually click the SEND button in
Outlook ... and then the second email is sent to Outlook ... and so on...

The list of email addresses is getting quite long and I want to automate
clicking the SEND button in Outlook from the VBA script...but don't know how!

Here is the VB code currently that works perfectly as long as I manually
click the SEND button in Outlook for each email:

Dim counter As Integer
Dim origemailstosend As Integer

counter = 1
origemailstosend = Me![totalemails]

While counter <= origemailstosend

DoCmd.SendObject _
, _
, _
, _
[eMailclean], _
, _
"(e-mail address removed)", _
"Thank you for your purchase!", _
"Thank you for your purchase of the Money Matters handout and
bible study series." & Chr(13) & Chr(13) & "Your Username is: " &
[Acct_Number] & Chr(13) & "Your Password is: " & [ZipCode] & Chr(13) &
Chr(13) & "Please go to www.ourcompany.org and click on the Stewardship
Download Center to download your Money Matters files." & Chr(13) & Chr(13) &
"Sincerely," & Chr(13) & Chr(13) & "Customer Service" & Chr(13) & "our
company", _
True

Me![totalemails] = Me![totalemails] - 1
Requery
counter = counter + 1
Wend

DoCmd.Close

What I need to know is how to programatically click the SEND button in
Outlook in the VBA code, or another way to release the email so the WEND can
continue to loop without manually clicking the SEND button.

Or, is there a way to change Outlook to send/receive every second instead of
every minute (minimum normally).

Thanks for any help.

 

[Danny Lesandrini]

You need Outlook Redemption.
http://www.dimastr.com/redemption/

Down below is code I use to send emails. It's not been cleaned up much, but it works.

--
Danny J Lesandrini
(e-mail address removed)
www.amazecreations.com


Option Compare Database
Option Explicit

Public Function SendMailItem(ByVal strRecips As String, ByVal strSubject As String, ByVal strBody As String) As Long
On Error Resume Next

Dim objOut As Object ' Outlook.Application
Dim objEmail As Object ' MailItem
Dim objSafeItem As Object ' Redemtpion Safe Object
Dim lngItem As Long
Dim strFile As String
Dim strName As String
Dim strFirst As String
Dim strLast As String
Dim fSend As Boolean
Dim strErrMsg As String
Dim iEnd As Integer
Dim iStart As Integer
Dim strRecip As String
Dim strMsg As String
Dim strComments As String

Const clngOutMailItem As Long = 0


strMsg = "Do you want to preview these emails before sending?"
If MsgBox(strMsg, vbExclamation + vbYesNo, "Note!") = vbNo Then fSend = True

' Get Outlook Application ... if it's already open
Set objOut = GetObject(, "Outlook.application")
If Err.Number > 0 Then
Err.Clear
Set objOut = GetObject(, "Outlook.application.10")
End If

If Err.Number > 0 Then
Err.Clear
Set objOut = GetObject(, "Outlook.application.11")
End If

If Err.Number > 0 Then
Err.Clear
Set objOut = GetObject(, "Outlook.application.12")
End If

' If an error occurred, then it's not open ... create from scratch.
If Err.Number Then
Err.Clear
Set objOut = CreateObject("Outlook.application")

' If another error has occurred, then Outlook couldn't be opened.
' Inform user and abort.
If Err.Number > 0 Then
strErrMsg = "Could not open Outlook. " & vbCrLf & vbCrLf & _
"Either Outlook is not installed correctly, " & vbCrLf & _
"or there is a problem with the installation. " & vbCrLf & vbCrLf & _
"Try opening Outlook before running this utility. " & vbCrLf & _
"If that also fails, contact the PTS dev team."
MsgBox strErrMsg, vbCritical, "Outlook Failed to Open"
Exit Function
End If
End If


' Allows for semi-colon delimited list of recipients
strRecips = Trim(strRecips)
If Right(strRecips, 1) <> ";" Then strRecips = strRecips & ";"
iStart = 1
iEnd = InStr(iStart, strRecips, ";") + 1

Do Until iEnd = 1
strRecip = Trim(Mid(strRecips, iStart, iEnd - iStart))

If Not IsEmail(strRecip) Then
' simple text for @ and DOT. If fails, skip the send.
Else
Set objEmail = objOut.CreateItem(clngOutMailItem)

Set objSafeItem = CreateObject("Redemption.SafeMailItem")
objSafeItem.Item = objEmail

With objSafeItem
.To = strRecip
.Subject = strSubject
.Body = strBody
.Save

' //////////////////// optional attachment code ////////////////////
' This code reads a list of attached files from a listbox on the
' current form named lstAttachments.
'
'For lngItem = 0 To Me!lstAttachments.ListCount - 1
' strName = Nz(Me!lstAttachments.Column(1, lngItem), "")
' strFile = Nz(Me!lstAttachments.Column(2, lngItem), "")
'
' If strFile <> "" Then
' .Attachments.Add strFile, 1, 1, strName
' strComments = strComments & vbCrLf & "ATTACHMENT: " & strName
' End If
'Next
' //////////////////// optional attachment code ////////////////////

If fSend = True Then .Send Else .display
End With
End If

iStart = iEnd
iEnd = InStr(iStart, strRecips, ";") + 1
Loop
Set objEmail = Nothing

Set objSafeItem = Nothing
Set objEmail = Nothing
Set objOut = Nothing

End Function

Public Function IsEmail(ByVal sEmail As String) As Boolean
On Error Resume Next

Dim fSuccess As Boolean

' Assume success
fSuccess = True

If InStr(1, sEmail, "@") = 0 Then fSuccess = False
If InStr(1, sEmail, ".") = 0 Then fSuccess = False

IsEmail = fSuccess

End Function