Coding doesn't reset till mouse click

[sassriverrat]

I have some coding I've written- it's designed to send an automated email in the event that an error comes up in the coding for the workbook...anyway- when it runs it generates a window for outlook that, after 5 seconds, allows you to allow or deny the automated email to be sent. If clicking "Allow", everything is great. If clicking "Deny", the coding used to error. I fixed the end of it and it works great, however, the result has been that the excel workbook will flash and I don't get the code-generated msbox ("Your antivirus blah blah blah) unless I click the mouse...so it's like the coding is looping until the click of a mouse or something. As soon as I click, the msgbox pops up and all continues to be well. Any idea what causes this? Thanks!

Public Sub Email_Developer()

    Dim OutApp As Object, OutMail As Object
    Dim emailSubject As String, bodyText As String, toEmailAddresses As String
    Dim cell As Range, printRange As Range
    Dim TempFileName As String
    Dim TempErrorFile As String
    Dim name As String
    Dim path1 As String
    Dim path2 As String
    name = Sheets("Notes").Range("N4")
        
    'Sets parameters of email
    With ThisWorkbook.Worksheets("Developer")
        emailSubject = .Range("D48").Value
        bodyText = .Range("D50").Value
        toEmailAddresses = ""
        
        For Each cell In .Range("D46")
            If cell.Value = "" Then
                MsgBox "No Email Address Specified", vbOKOnly, name
                Exit Sub
            Else: If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
            End If
        Next
        path1 = .Range("E44")
        path2 = .Range("J44")
        
    End With


    'sets active sheet type (pdf)
    With ThisWorkbook
        
        TempFileName = Environ("temp") & "\" & .name & " Report " & Format(Now, "dd-mmm-yy") & ".pdf"
        TempErrorFile = path1 & "\" & path2 & ".txt"
    
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
            
    End With
Starter:
    'sets outlook to run
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    'Decide to include the error log if it exists (as it should)
    If Dir(TempErrorFile) <> "" Then
        GoTo Email1
        Else: GoTo Email2
    End If
    'On Error Resume Next
Email1:
On Error GoTo Denial
    With OutMail
        .to = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = bodyText
        .Attachments.Add TempFileName
        .Attachments.Add TempErrorFile
        .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Kill TempFileName
    GoTo Confirmation
Email2:
    On Error GoTo Denial
    With OutMail
        .to = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = bodyText
        .Attachments.Add TempFileName
        .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Kill TempFileName
    GoTo Confirmation
Confirmation:
MsgBox "Your email has been sent. If your antivirus asks to allow this email to be sent, please click [Allow]. Thank you.", vbOKOnly, name
Exit Sub
Denial:
resp = MsgBox("Your antivirus requires you to click [Allow} in the popup message to allow the email to send. Please retry sending. Thank you", vbRetryCancel, name)
If resp = vbRetry Then
    GoTo Starter
ElseIf resp = vbCancel Then
    Exit Sub
End If
End Sub

 

[sassriverrat]

bump