ajetrumpet
07-25-2009, 08:34 PM
all,
i am trying to send a bulk mailing out through outlook, and i am getting stuck after a certain period of time of sending. here is my code for the loop:Function sendall()
'Creates a new e-mail item and modifies its properties
Dim oNS As Object
Dim oContacts As Object
Dim oContactItem As ContactItem
Dim objMail As MailItem
Set oNS = Application.GetNamespace("MAPI")
Set oContacts = oNS.Folders(1).Folders("Contacts")
For Each oContactItem In oContacts.Items
If oContactItem.CompanyName = "temp" Then
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.To = oContactItem.Email1Address
.Subject = "TEST MESSAGE FROM " & oContactItem.FullName
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>THIS IS A TEST MESSAGE FROM " & _
oContactItem.FullName & "</BODY></HTML>"
'.Display
.Send
End With
End If
Next
Set oContactItem = Nothing
Set oContacts = Nothing
Set oNS = Nothing
Set objMail = Nothing
End Functionthese message will send right away if i specify to "send immediately on connect" in the email options. if i don't send immediately, they pile up in the outbox and sit there. either way is fine with me, but my outlook is stalling on the send process at message #85 if i send say, 250 messages out. it always stalls around that spot. i tried placing a fake 5 second "pause" code snippet after the .send action to give outlook some time to complete the current sending before moving on to the next, but that stalls out at the same place as well. the code i tried is this:
'PauseTime = 5
'Start = Timer
'Do While Timer < Start + PauseTime
'DoEvents
'Loop i am looking for some pointers in the right direction here as to how to solve this problem. i would appreciate any help that you all could give me on this one. thanks!
i am trying to send a bulk mailing out through outlook, and i am getting stuck after a certain period of time of sending. here is my code for the loop:Function sendall()
'Creates a new e-mail item and modifies its properties
Dim oNS As Object
Dim oContacts As Object
Dim oContactItem As ContactItem
Dim objMail As MailItem
Set oNS = Application.GetNamespace("MAPI")
Set oContacts = oNS.Folders(1).Folders("Contacts")
For Each oContactItem In oContacts.Items
If oContactItem.CompanyName = "temp" Then
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.To = oContactItem.Email1Address
.Subject = "TEST MESSAGE FROM " & oContactItem.FullName
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>THIS IS A TEST MESSAGE FROM " & _
oContactItem.FullName & "</BODY></HTML>"
'.Display
.Send
End With
End If
Next
Set oContactItem = Nothing
Set oContacts = Nothing
Set oNS = Nothing
Set objMail = Nothing
End Functionthese message will send right away if i specify to "send immediately on connect" in the email options. if i don't send immediately, they pile up in the outbox and sit there. either way is fine with me, but my outlook is stalling on the send process at message #85 if i send say, 250 messages out. it always stalls around that spot. i tried placing a fake 5 second "pause" code snippet after the .send action to give outlook some time to complete the current sending before moving on to the next, but that stalls out at the same place as well. the code i tried is this:
'PauseTime = 5
'Start = Timer
'Do While Timer < Start + PauseTime
'DoEvents
'Loop i am looking for some pointers in the right direction here as to how to solve this problem. i would appreciate any help that you all could give me on this one. thanks!