0

I have a macro I built to send out batches of emails to clients, using personalized info for each client. It's been working great, but it's just been brought to my attention that the macro doesn't create emails after about the 67th draft that populates in Outlook when you run the macro. I've tried to research and haven't found a constraint restriction as to how many email drafts Outlook will let you have open at once. I've posted my code below in case anyone can see if I inadvertently set up a limit.

How the macro works: Employees have a list of about 500 accounts that they need to contact via email every month about renewing their contract with us. All of the info is in an Excel file, and this macro pulls each clients email address, customer name, customer contact, renewal date, etc. and uses that info in each email for a more personalized email. Once the employee hits the button to run the macro, it will create an email for each account in the list, populating in Outlook. I have the emails populate in Outlook instead of automatically sending in case the employee wants to edit or add more information to an email depending on the client. Most cases they send the email as is, but the employees do edit a few emails. So while it seems daunting to have so many drafts populate in Outlook at once, it's much faster for the employees to send out emails this way instead of typing each one out individually.

So any advice or insight on why I can't send more than 67 emails at once when the macro should run through the last row of information, please let me know. If not I will just have to tell the employees to only use the macro in batches of 60 I suppose. 

Sub SendEMail()


Dim Email As String
Dim Subj As String
Dim Msg As String
Dim URL As String
Dim r As Integer
Dim x As Double
Dim OApp As Object
Dim OMail As Variant
Dim Signature As String
Dim strbody As String

'for formatting reasons
strbody = "<html><body>"

'for looping
With Sheets("List").Select
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
End With

For r = 2 To lastrow


Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)


'       Get the email address
Sheets("List").Select
Email = Cells(r, "K")

'       Message subject
    Sheets("List").Select
Subj = "Renewal for " & Cells(r, "B").Text & " Client # " & Cells(r, "A").Text & " Effective " & Cells(r, "D").Text

'       Message body
Sheets("List").Select
strbody = "<p>Dear " & Cells(r, "J").Text & ", </p>" & _
"I am contacting you regarding the upcoming renewal for " & Cells(r, "B").Text & ", account number " & Cells(r, "A").Text & ", which is effective " & Cells(r, "D").Text & ". We have reviewed the account and determined that we have the information we need on file in order to offer renewal terms. & _
"Should you have any questions or if we can be of futher assistance, please don't hesitate to contact " & Cells(r, "O").Text & " at " & Cells(r, "M").Text &                 " or " & Cells(r, "N").Text & _
" or respond to this email. If you are aware of changes to the contact on this account, please let us know, so we can be sure to get future correspondence to the proper person.<br><br>" & _
"As always, we would like to thank you for your business.<br><br>" & _
"Sincerely,"

On Error Resume Next

Sheets("List").Select
With OMail
.Display
.To = Email
.Subject = Subj
.HTMLBody = strbody & vbNewLine & .HTMLBody
End With
Next r

On Error GoTo 0


Set OMail = Nothing
Set OApp = Nothing

End Sub
Community
  • 1
  • 1
newkid59
  • 19
  • 3
  • 7
  • What happens after 67 emails. Does the code stop without errors, or is there an error on a particular line in your code? Please explain in further detail. – David G Jul 20 '16 at 14:21
  • There seems to be a Compiler Error - Syntax error on the paragraph `strbody = "

    Dear " & Cells(r, "J").Text & ",

    " & _ .....`. Please recheck the code from your master code.     – skkakkar Jul 20 '16 at 14:29
  • Remove the `On Error Resume Next` statements and let it fail so you can see what and where it fails? – Dave Jul 20 '16 at 14:40
  • After 67 emails there's no error message, the emails just stop populating, so you assume that it ran through all of them. – newkid59 Jul 20 '16 at 17:38
  • I removed the On Error Resume Next, and this is the error message I got: Run-time error '-2147024882 (8007000e)': Out of memory or system resources. Close some windows or programs and try again. So it is a limit issue. Any suggestions on how to go from here? Just off the top of my head I'm thinking making separate macros for every 50 or 60 lines, and run emails just for each chunk of 50. Then employees don't forget which emails they've gone through so far. – newkid59 Jul 20 '16 at 18:07

2 Answers2

0

So here is some code that could handle your problem two ways. One is to limit the batch amount... The other is to save the mailobject in the my documents folder in each for loop, the set the mail objects as nothing. This should give the users the ability to run all the accounts at once, but open and edit before they send... which brings me to my real solution.

Find out what scenarios these users are editing emails, then code for them. Also, if the users are manually looking at each email before it is sent. Maybe get rid of the loop entirely and have them click a button when they want the next available account on the spreadsheet. This could be accomplished by having a column with "sent status" on it. 

Option Explicit

Sub SendEMail()
Dim Email As String
Dim Subj As String
Dim Msg As String
Dim URL As String
Dim r As Integer
Dim x As Double
Dim OApp As Object
Dim OMail As Variant
Dim Signature As String
Dim strbody As String

'for formatting reasons
strbody = "<html><body>"

'for looping
With Sheets("List").Select
    lastrow = Cells(Rows.Count, "B").End(xlUp).Row
End With

For r = 2 To lastrow


    Set OApp = CreateObject("Outlook.Application")
    Set OMail = OApp.CreateItem(0)


'       Get the email address
    Sheets("List").Select
    Email = Cells(r, "K")

'       Message subject
    Sheets("List").Select
    Subj = "Renewal for " & Cells(r, "B").Text & " Client # " & Cells(r, "A").Text & " Effective " & Cells(r, "D").Text

'       Message body
    Sheets("List").Select
    strbody = "This was a syntax error, changing for simplicity."

    On Error Resume Next

    Sheets("List").Select
    With OMail
        .display
        .To = Email
        .Subject = Subj
        .HTMLBody = strbody & vbNewLine & .HTMLBody
''New
        .SaveAs ("C:\Users\" & Environ$("Username") & "\Documents\" &     Environ$("Username") & r & ".msg")
    End With
    Set OMail = Nothing
    Set OApp = Nothing

'''        'If you decide to limit your batches do it here
'''        If r = 62 Then
'''          MsgBox "Could do an assortment of things here...anyways, its     not a very good solution. "
'''        End If

    Next r

    On Error GoTo 0


    Set OMail = Nothing
    Set OApp = Nothing

End Sub

Also, and this is completely up to you and your business needs. I would really consider moving the strbody out of the hardcode and into a new sheet/text file or available cell in the spreadsheet. Makes support so much easier down the line.

After reading your comment above about memory.. the problem is all of those open email messages. You might want to use the save method above, then write a new macro that will open a file with the oldest date modified from that directory, after they click send have the file delete or archive... Something like that.

BigElittles
  • 116
  • 2
0

I have built a similar batch tool and hit the same issue, but found it to be unpredictable. Looking for a solution I settled for throttling the speed at which the script generates the mails, roughly 500 milliseconds per mail - my mails carry multiple attachments so smaller mails may need less throttling.

I can now very stability create > 100 emails with total size (all emails combined) ranging between 200Mb and 300Mb.

I have the impression it is a technica issue in the interface between Excel/VBA and Outlook.

klaas
  • 1