Excel email MSG override

[sassriverrat]

I have a sub that emails the activesheet print area. Works like a champ. However, when I run it, an excel pops up that says the workbook is trying to open/run outlook and send an email and if I want to stop this, hit deny before the loading bar goes all the way across. Anyway, if I let the loading bar run, it works like a champ. If I hit "deny", it stops the email (fine) and then vba pops up that the sub was stopped and asks me to "end" as if I had an error in my coding. Is it possible to either add a piece of code to have it stop exit the sub if the user hits deny OR a piece of coding that just stops that message from popping up altogether?

thanks!

code below

Public Sub Email_Active_Sheet()

    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 name As String
    name = Sheets("Notes").Range("N4")
        
    'Sets parameters of email
    With ThisWorkbook.Worksheets("Notes")
        emailSubject = .Range("L45").Value
        bodyText = .Range("L46").Value
        toEmailAddresses = ""
        
        For Each cell In .Range("L37:L43")
            If cell.Value = "" Then
                Exit Sub
            Else: If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
            End If
        Next
    End With
    
    'sets active sheet type (pdf)
    With ThisWorkbook.ActiveSheet
        
        TempFileName = Environ("temp") & "\" & .name & " Report " & Format(Now, "dd-mmm-yy") & ".pdf"
    'Check Print Range
        If .PageSetup.PrintArea = vbNullString Then
            MsgBox (Environ("temp") & "\" & .name & " Report " & Format(Now, "dd-mmm-yy") & ".pdf")
            MsgBox "You must first set the Print Area(s) on the '" & .name & "' sheet.", vbExclamation, name
            Exit Sub
        End If
    'Continue with email piece
        Set printRange = Range(.PageSetup.PrintArea)
        
        printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
    End With
    
    'sets outlook to run
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next
    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
        
End Sub

 

[sassriverrat]

bump

 

[sassriverrat]

bu