Email Macro Pauses every 40 - 50 emails

Question

I have a semi-working macro that

1. Loops through a list of Managers
2. Generates a email body for each manager
3. Filters a sheet of all data relevant for each manager
4. Converts the visible cells to a HTML table
5. Adds the table to email
6. Send

The issue is the macro stops generating emails every 50 iterations in and does not error out - it just appears to "run" without doing anything. I have manually stopped the macro and there is no consistent line that appears to be getting stuck. Cutting this down to bare bones as much as I can, but I have no clue where the issue is. When I step through, I can't recreate the issue. When I re-run, the first 50ish go fine and then it stops generating.

I have also tried adding Application.Wait call at the end of each loop iteration and get same issue

I end up having to CTRL + BREAK to stop the macro. When I restart its coded to pick up right where it left off and it sends the next batch just fine (meaning the line it gets paused on runs just fine when I start again). Issue is not every once in a while - it's gets stuck like clock work.

---

Start of macro (just generates a text body)

Sub Initiate()

    Dim EmailBody As String
    EmailBody = "HTML TEXT BODY HERE"

    Builder EmailBody     '<---- Call loop

End Sub

Performs the loop on managers and filters the other sheet for relevant data. Passes all ranges on to the macro to build email

Sub Builder(EmailBody As String)

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Distro List")
Dim Raw As Worksheet: Set Raw = ThisWorkbook.Sheets("Email Data")

Dim LR As Long, LR2 As Long
Dim EmailTable As Range, Target As Range, EmailRange As Range

LR = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
Set EmailRange = ws.Range("C2:C" & LR)
LR2 = Raw.Range("A" & Raw.Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

For Each Target In EmailRange
    If Target.Offset(, -2) = "y" Then
        If Len(Target.Offset(, -1)) = 6 Then
            If Right(Target.Offset(, 1), 7) = "@so.com" Or Right(Target.Offset(, 1), 11) = "@StackO.com" Then
            

                Raw.Range("A1:H" & LR2).AutoFilter 1, Target.Offset(, -1), VisibleDropDown:=False
                Raw.Range("A1:H" & LR2).SpecialCells(xlCellTypeVisible).Columns.AutoFit
                Set EmailTable = Raw.Range("A1:H" & LR2).SpecialCells(xlCellTypeVisible)
                            
                Sender EmailBody, EmailTable, Target
                        
                Set EmailTable = Nothing
            
            End If
        End If
    End If
Next Target

Application.ScreenUpdating = True

End Sub

Build email, call HTML Table generator macro, add HTML Table, SEND email

Sub Sender(EmailBody As String, EmailTable As Range, Target As Range)

Dim OutApp As Object
Dim OutMail As Object

On Error GoTo BNP:

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .SentOnBehalfOfName = "urdearboy@so.com"
            .to = Target.Offset(, 1)
            .Subject = "Your Employees....."
            .HTMLBody = "<p style = 'font-family:arial' >" _
                        & EmailBody & "</p>" _
                        & RangetoHTML(EmailTable) _
                        & "<p style = 'font-family:arial' >"
        
            .Send
            
            Target.Offset(, -2) = "Sent"
        End With
        
BNP:
    Set OutApp = Nothing
    Set OutMail = Nothing

End Sub

Macro I found online that converts a excel range to a HTML table that can be inserted into email.

Function RangetoHTML(EmailTable As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    EmailTable.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Answer 1

Extremely glad, yet also annoyed, to say that adding a Applitcation.Wait for 1 second to the function RangetoHTML fixed the issue.

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile
    
    Application.Wait Now + #12:00:01 AM#                 '<------ Resolved Issue

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

---

Still curious to know what the actual issue is since I suspect that this is a work around to the actual issue. Just glad I can finally use this macro to send large distro's without it pausing every 4 minutes!