Sub Mail()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrBody As String
    Dim SigString As String
    Dim Signature As String
 
    StrBody = "<p style='font-family:Tahoma;font-size:12;margin-bottom:.0001pt'>The Weekly Plan Status dated M.D.YY is attached and " _
    & "at Q:\Audit\CAS Plan Status\2018 Plan Status Reports\3Q 7.10.18 to TBD\Weekly.</p>" _
    & "<p style='font-family:Tahoma;font-size:12'>Current Period Highlights:</p>" _
    & "<ul><p style='font-family:Tahoma;font-size:12'>" _
    & "<li><p style='font-family:Tahoma;font-size:12'>NN audit reports issued</li></p>" _
    & "<li><p style='font-family:Tahoma;font-size:12'>NN xxxx issued</li></p>" _
    & "</ul>" _
    & "<p style='font-family:Arial;font-size:12'<Strong>Professional Practices | Corporate Audit Services</Strong><br>" _
    & "professional.practices@usbank.com<br><br>" _
    & "<strong>U.S. Bancorp</strong><br>" _
    & "<strong>U.S. Bank Plaza</strong><br>" _
    & "200 South 6th Street, Minneapolis, MN 55402 | EP-MN-L8CA | www.usbank.com</p>"
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Weekly Plan Status " & Format(Date, "m.d.yy")
        .HTMLBody = StrBody
        .Attachments.Add ActiveWorkbook.FullName
        .Display   'or use .Send
    End With
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub