How to Send Multiple Emails using Outlook 2003 VBA under Exchange Server?

[snaux]

I've written an Outlook 2003 VBA script which creates multiple emails
in the drafts box. I'd like to send them all, but at the 100th "send"
command the system chokes, and the emails get moved or deleted, but are
not actually sent out.

Here's my code:

Sub SendMerge()
Dim oItem As MailItem
Dim olfldrSource As MAPIFolder
Dim nSendCount As Integer
nSendCount = 1
doneScan = False
While (doneScan = False)
Set olfldrSource =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
If (olfldrSource.Items.count() = 0) Then
doneScan = True
End If
Set oItem = olfldrSource.Items(1)
DoEvents
Debug.Print nSendCount & " Sending: " & oItem.To & " Email:
" & oItem.Subject
nSendCount = nSendCount + 1
oItem.Send
Set oItem = Nothing
Set olfldrSource = Nothing
Wend
End Sub

I know similar problems have been discussed before, but I've not seen a
conclusive answer. After reading the boards, I believe the problem is
that I've exceeded the number of COM objects allowed by the Exchange
Server, but this is just a guess.

I've also seen posts about explicit Garbage Collection above and beyond
setting all Objects = Nothing, but I've seen no examples on how to do
this.

Does anyone have any suggestions? What am I doing wrong and how do I
fix this?

 

[Ken Slovak - [MVP - Outlook]]

VBA doesn't suffer the garbage collection problems that .NET code does.

Outlook creates internal object variables and usually doesn't release them
until the procedure ends, even if you set the explicit object to Nothing.
You can minimize the problem by not using objects with lots of dot operators
but with explicit objects, but that just minimizes the problem.

You can either use an alternate API such as CDO 1.21 that doesn't have the
problem to the same extent or you can call your procedure multiple times.

You may also have a server imposed limit on sending.

 

[snaux]

Does anyone have any suggestions? What am I doing wrong and how do I
Well, I found a workable solution finally, although it's a tad slow:
After creating and saving all the items to the Drafts folder, I user
the User32.dll to set up a timer object, which is invoked every 500ms.
It scans the drafts folder, and if it finds anything, it sends one
item, then invokes itself to fire again in another 500ms. It can
probably be set even faster, but at 2AM I was not feeling experimental!

By setting it as a timed event rather than trying to run it all from a
loop, we avoid the problems inherent in the COM/Exchange interaction...
each "Send" is its own alpha and omega, so nothing queues up... the
system gets a chance to breathe and reallocate resources. This method
is probably useful for other large asynchronous tasks.

Here's the basic code, for anyone else with this problem. The "500&" in
the StartTimer Sub is the milliseconds between fires. Just dump this
whole code below into a module, and call StartTimer() from anywhere to
invoke it.

And yes, this can be written better, but like I said, it was 2AM and I
didn't really give a darn!

Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long

Public Sub StartTimer()
TimerID = SetTimer(0&, 0&, 500&, AddressOf TimerProc)
End Sub

Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Public Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim oItem As MailItem
Dim olfldrSource As MAPIFolder
Set olfldrSource =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
If (olfldrSource.Items.count() > 0) Then
Set oItem = olfldrSource.Items(1)
oItem.Send
Else
' if the Drafts folder is finally empty, stop the timer:
EndTimer
End If
Set oItem = Nothing
Set olfldrSource = Nothing
End Sub