Email macro to send only certain columns

[Willie03]

I have a file where the names of about 500 employees come up that have not taken a course. I have a total of 10 columns in the file with the information needed to send the employees reminders of the courses that need to be completed.
Basically in column "B" we have the names of the employees and in column "I" the employees manager. There may be 5 employees who report to the same manager but only one email should be sent to that manager. So we filter column "I" and send the list of names that come up per manager but only send columns "A & B" in the email to each manager. i have a column with a yes which is column J and would not like to use it anymore either.
My problem is when I run the macro wont do anything at all. Any ideas what I may be doing wrong? I also added the Option Explicit at the top and still get nothing?
Any help will be greatly appreciated...

Sub Audio_Macro()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim rng As Range
    Dim Ash As Worksheet
    Dim StrBody As String
    
    Set Ash = ActiveSheet
    On Error GoTo cleanup
    Set OutApp = CreateObject("Outlook.Application")


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For Each cell In Ash.Columns("I").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" _
           And LCase(cell.Offset(0, 1).Value) = "Yes" Then


            Ash.Range("A1:H200").AutoFilter Field:=1, Criteria1:=cell.Value


            With Ash.AutoFilter.Range
                On Error Resume Next
                Set rng = .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
            End With
            
    StrBody = "Bom dia, " & cell.Offset(, -1) & "<br>" & "<br>" & _
              "Por gentileza encaminhar o(s) colaborador(e)s da lista anexa, hoje 04/09 ao Ambulatório mais próximo para orientação do exame de AUDIOMETRIA." & "<br>" & "<br>" & _
              "Caso necessário resposta, envie a mensagem somente para Mickey Mouse." & "<br>" & "<br>" & _
              "Att," & "<br><br>"


            Set OutMail = OutApp.CreateItem(0)


           On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Convocação para Audiometria"
                .HTMLBody = StrBody & RangetoHTML(rng)
                .Display
                '.Send
            End With
            On Error GoTo 0
            
            Set OutMail = Nothing
            Ash.AutoFilterMode = False
        End If
    Next cell


cleanup:
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub


Function RangetoHTML(rng As Range)


    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False


    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function