Save and Send Macro - Determine importance based on cell value

[sacastiglia]

Hello,

I have a save and send macro that will send a timesheet with no importance noted. I would like to send this email with high importance only if any cell in range P6 thru P11 is greater than 10 or change the subject line font color to red.

Any help would be greatly appreciated.

My code is shown below:

Option Explicit
Sub Mail_Workbook_Outlook_2()
' TX
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim DatePicked As String
    Dim PcName As String
    Dim SavedName1 As String
    Dim SavedName2 As String
    Dim SavedName3 As String
    Dim SavedName4 As String
    Dim SavedName5 As String
    Dim SavedName6 As String
    Dim SavedName7 As String
    Dim ws As Worksheet
    
DatePicked = Worksheets("BLANK").Range("C5").Value
PcName = Worksheets("BLANK").Range("C4").Value
SavedName1 = Worksheets("BLANK").Range("E6").Value
SavedName2 = Worksheets("BLANK").Range("E7").Value
SavedName3 = Worksheets("BLANK").Range("E8").Value
SavedName4 = Worksheets("BLANK").Range("E9").Value
SavedName5 = Worksheets("BLANK").Range("E10").Value
SavedName6 = Worksheets("BLANK").Range("E11").Value
SavedName7 = Worksheets("BLANK").Range("C6").Value
    Set wb1 = ActiveWorkbook
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name
        FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
    Set OutApp = CreateObject("Outlook.Application")
    
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "abc@abc.com"
        .CC = ""
        .BCC = ""
        .Importance = "olImportanceHigh"
        .Subject = PcName & "-" & DatePicked & " for Job #: " & SavedName7 & ":  " & SavedName1 & " - " & SavedName2 & " - " & SavedName3 & " - " & SavedName4 & " - " & SavedName5 & " - " & SavedName6
        '.Subject = "NEW ACCESS REQUEST & VendorName & DatePicked"
        .Body = "Daily Foreman Report Attached"
        'VendorName = Worksheets("Sheet1").Range("G12").Value
        .Attachments.Add wb2.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Importance = 2
        .Display
    End With
    
    On Error GoTo 0
    wb2.Close SaveChanges:=False
    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With
Sheets("BLANK").Range("C4:C11").ClearContents
Sheets("BLANK").Range("E6:M11").ClearContents
Sheets("BLANK").Range("D17:D24").ClearContents
Sheets("BLANK").Range("H17:J40").ClearContents
Sheets("BLANK").Range("O17:P21").ClearContents
Sheets("BLANK").Range("O24:P28").ClearContents
ActiveSheet.Shapes("TEXAS").Visible = False
End Sub