VBA Send bulk emails performance concern

2020-05-07 06:33发布

问题:

I have the below macro which will scan an excel file with manager emails down Col B. For each manager, an email will be drafted/an excel file attached/ and sent automatically. I have been able to test this and it is working fine when drafting 50 - 100.

My concern is, 50 - 100 emails does not seem like a good indicator of knowing if this will work fine when sending 5,000 emails.

Am I at risk of this freezing or other issues when running this on actual file with 5,000 emails?

Sub CorpCard()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And LCase(Cells(cell.Row, "C").Value) = "yes" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .SentOnBehalfOfName = "urdearboy@hi.com"
            .to = cell.Value
                .Subject = "Your Employees With A Corporate Credit Card - EID - " & Cells(cell.Row, "D").Value
                .Body = "Hi " & Cells(cell.Row, "A").Value & "," _

                'Body to be patsed here

            strLocation = "C:\Users\urdearboy\Desktop\File Name " & Cells(cell.Row, "D").Value & ".xlsx"
            .Attachments.Add (strLocation)
        .Send
        End With

        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Would it be a good idea to house my For Each loop inside another loop something like For i = 1 to 5000 Step 50 and then add Do Events before starting the actual loop to give my computer some time to catch up before proceeding with the next 50 emails? I'm not exactly sure if this is in the scope of Do Events though. I can also provide computer specs if necessary.

回答1:

This should work fine for larger files. With that number of emails to send though, your run time could easily be over an hour. A good idea might be to raise some flag in the error handler in case it does encounter an issue. Maybe something like:

    if Err then
         Msgbox "Error Encountered at Row " & cell.row
    end if 

right underneath the with-block.