Odd duplicate email error sending Outlook 2003 emails from Excel 2003

[Harlylux]

Hi All-

I needed to write a macro for a client that takes some data from excel and email merges from Outlook, both in 2003. I have written many macros similar to this and have never had a problem. However, with this client, it seems that the macro sends out two emails when every time I have tested it, it sends out a single email to each recipient (as it should). I have no idea what's going on so I tested the code in different Office 2003 service packs, but it still works fine in my environment. This is generic 2003 vba code where you create all drafts of the emails in outlook, and then send them one by one after all are created. here's the vba from excel. Any thoughts? Thanks in advance!

Sub GenerateEmailDrafts()

Dim i As Integer
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim wb_URL As Workbook
Dim wk_URL As Worksheet
Dim ErrorMessage As String
Dim CountURL As Integer
Dim Cell As Variant
Dim range_URL As String


On Error GoTo ErrorHandler

'Initialize variables
Set wb_URL = ThisWorkbook
Set wk_URL = ThisWorkbook.Sheets("Data")

ErrorMessage = "Please make sure Outlook is open and then run this step again."
Set objApp = CreateObject("Outlook.Application")
ErrorMessage = ""

CountURL = wk_URL.UsedRange.Rows.Count
range_URL = "A2:A" & CountURL

For Each Cell In wk_URL.Range(range_URL)
Set l_Msg = objApp.CreateItem(olMailItem)

l_Msg.To = Cell.Offset(0, 3).Value
l_Msg.Subject = EmailSubject

l_Msg.HTMLBody = EmailTemplate(Cell.Offset(0, 2).Value, Cell.Offset(0, 1).Value, Cell.Offset(0, 4).Value)
l_Msg.Save
l_Msg.Close (olSave)

Set l_Msg = Nothing


Next Cell

Set objApp = Nothing

'Success, send everything in drafts

Call sendDrafts(True)

'Close this Application
Application.Quit
ThisWorkbook.Close SaveChanges:=True

Exit Sub
'....
End Sub

Sub sendDrafts(RunNow As Boolean)
Dim objApp As Outlook.Application
Dim objNew As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.Namespace, objItem As Outlook.MailItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = Outlook.Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderDrafts)
On Error Resume Next
Do
For Each objItem In objInbox.Items
objApp.ActiveExplorer.Activate
Application.Wait (Now + TimeValue("0:00:02"))
objItem.Display
SendKeys String:="%s", Wait:=True
Next objItem
Set objItem = Nothing
Loop Until objInbox.Items.Count = 0
End Sub

 

[UnsolvedCoding]

Is there a reason you are sending what is in your drafts and using send keys instead of just using .send?

 

[UnsolvedCoding]

Here is code that will create and send an email for you without needing to go back into outlook and runs regardless of if outlook is open. All you have to do is put values into the variables.



' Creating An email
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm

' Put the subject line info in the subject line
.Subject = ESubject

' Put who the email is going to in the to line
.To = Contact_Email

' Insert the message into the email
.Body = Ebody

' Show the user the email that was just created
.Display

' Save email
.Save

' Send the email
.Send

End With

' Clear and exit email
Set App = Nothing
Set Itm = Nothing

 

[UnsolvedCoding]

Oh ya, the code just given will show the email and save a copy prior to sending it. If you don't want to save a copy or don't want to see it just remove or comment out those lines.

 

[Harlylux]

Hey-

I'll give this a shot, thanks for your advice. To answer your question, this code breaks the creating emails (and storing in drafts folder) step and the sending emails into two different steps because this will get around the security issues from Outlook 2003. I don't program in VBA 2003 much, but I remembered from it you don't do it this way, than otherwise you have to have the user click that they allow you to have control of Outlook which can be a pain (but I could be wrong). We'll be spending 1000s of emails, so I'll try your code and see if I don't have this issue.

Thanks again for your quick response!

 

[UnsolvedCoding]

Since you don't code much here is how I declare the variables. ALso note that typically I don't save emails since they are in my sent items anyway. Showing them before they go is a personal preference and is included here so if you want to see it you can stop the code and view it, but at full speed it will probably only flicker.

Sub Email()

' Creates email
Dim App
Dim Itm

' Subject line for email
Dim ESubject As String

' Message of email
Dim Ebody As String

' The email address of the contact person
Dim Contact_Email As String

ESubject = "Checking in"

Ebody = "Hello, I am doing well" & VBCRLF & "Have a good day."

' Either works, the top is for the same person to get all email
' the bottom is if the personals email is pulled off a worksheet.
Contact_Email = "Someone@somewhere.com"
Contact_Email = Trim(Range("E2").value)

' Creating An email
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm

' Put the subject line info in the subject line
.Subject = ESubject

' Put who the email is going to in the to line
.To = Contact_Email

' Insert the message into the email
.Body = Ebody

' Show the user the email that was just created
.Display

' Send the email
.Send

End With

' Clear and exit email
Set App = Nothing
Set Itm = Nothing

End sub

 

[Harlylux]

Hey-

I just tried the code and this code snippet does force you to click yes before each email is sent which is what I remembered, and won't work when sending large batches. By creating all emails at once and then sending them all, you are able to get around this message, except for this one client, it's not working that way. Any other ideas why they would be experiencing duplicate emails?

The only other thing I can think of is that they run a Novell Groupwise backend which they connect Outlook to, and my programs typically pull from Exchange, but I have no idea if this would affect the macro or not.

Thanks again.

 

[UnsolvedCoding]

The macro I just gave you we use to send massive amounts of emails from a list of our various clients. It does not require clicking checkboxes.

That reminds me of something - if you are trying to send emails to a group of people you will always get a security warning if to many people are on the to list because Outlook reads it as an outgoing virus. Try breaking it down into small groups of people.

 

[Harlylux]

Hey-

Each email only has 1 "To" field and no "CC" and "BCC". For each email in the loop, there was a popup box from Outlook that said "A program is trying to automatically send e-mail on your behalf. Do you want to allow this" if you click yes, then one email sends and the a new popup showed up. I used your code exactly (except without the display and save) with a loop to send multiple emails... This is the behavior I remember unless you modify Outlook's application startup to disable some of its routines.

Any other ideas? I appreciate your help.

 

[UnsolvedCoding]

I have to think about this for a bit, I don't recall any other steps at the moment.