VB code sending infinity emails, how do I fix?

[billyheanue]

Hi all, my code is supposed to loop until line 20 (for example), but loops until you hit Ctrl+Break...

Very dangerous when the loop means your work email is autogenerating endless amounts of emails

Can someone diagnose the reason for this error?

I have:

Sub send_email_loop()
'
' send_email_loop Macro
' sends emails?
'
' Keyboard Shortcut: Ctrl+Shift+Q
'


row_number = 1


Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim po_number As String
    
    
    full_name = Sheet1.Range("B" & row_number) & " " & Sheet1.Range("C" & row_number)
    mail_body_message = Sheet1.Range("J2")
    po_number = Sheet1.Range("D" & row_number)
    
    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
    mail_body_message = Replace(mail_body_message, "PO_number_replace", po_number)
        MsgBox mail_body_message
Call Mail_workbook_Outlook_1




Loop Until row_number = 20 'this is just the example from video, row number will be 3000+




MsgBox "Complete!"




End Sub

this code calls Mail_workbook_Outlook_1, which is...

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = "william.heanue@steward.org"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ("H:\test_attachment.xlsx")
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

i dont want to have it keep looping forever!!

 

[StephenCrump]

There's no infinite loop in the code you've posted. It also doesn't look like it will trigger other event code, such as Worksheet_Change or Worksheet_SelectionChange. Are you sure it's this code causing the problem? Try stepping through it with the loop limit set to 1 and see what happens.

Your code does have other issues ...

Mail_workbook_Outlook_1 will generate the same template e-mail on each iteration of the loop, because you're not passing any customised values (e.g. name, purchase order) to it.