Hiding Email Warnings

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
625
So a gentleman on here made this piece of code, to be called within a macro, that eliminates the warning when opening URLs. Could this be tweaked so that when forcing excel to send an email (second code below), the warning for excel sending an email on your behalf was hidden?

thanks!

Rich (BB code):
Option Explicit 
Enum W32_Window_State
    Show_Normal = 1
    Show_Minimized = 2
    Show_Maximized = 3
    Show_Min_No_Active = 7
    Show_Default = 10
End Enum
 
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Function OpenURL(URL As String, WindowState As W32_Window_State) As Boolean
     
    'Opens passed URL with default application, or Error Code (<32) upon error
     
    Dim lngHWnd As Long
    Dim lngReturn As Long
     
    lngReturn = ShellExecute(lngHWnd, "open", URL, vbNullString, _
    vbNullString, WindowState)
     
    OpenURL = (lngReturn > 32)
     
End Function

email
Rich (BB code):
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
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
warnings during send of email via outlook can be related to out of date antivirus.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,446
Messages
5,547,971
Members
410,820
Latest member
Prepost
Top