Создать таблицу html из отфильтрованной таблицы Excel

Мне нужна небольшая помощь, поскольку я пытаюсь вставить отфильтрованную таблицу Excel в открытое сообщение электронной почты Outlook. Мне удалось сделать это с помощью функции, которую я нашел в Интернете (ExcelRangeToOutlookEmailBody), но она заменяет сообщение, которое у меня было перед вставкой таблицы, и я также не могу добавить какой-либо текст над или под таблицей, поэтому теперь я пытаюсь написать подпрограмму, которая динамически создает таблицу html, поскольку кажется, что с ней легче манипулировать, чтобы вставлять текст до и после таблицы.

У меня есть таблица с количеством проектов, приписываемых нескольким людям, и я хочу отфильтровать таблицу по каждому человеку, скопировать видимые строки и вставить ее в открытое сообщение электронной почты. Я хочу просто нажать кнопку, чтобы Excel создал несколько (обычно менее 10) сообщений электронной почты с отфильтрованной таблицей.

Код, который у меня есть, представляет собой смесь того, что я нашел в Интернете, плюс некоторые мои изменения, и он динамически строит таблицу html. Однако он работает только для первого человека, и с этого момента ему не удается построить таблицу html — он просто повторяет первую отфильтрованную таблицу. Чтобы упростить ситуацию, код ниже — это просто построитель html-таблиц, с остальным я разобрался (по крайней мере, я так думаю).

Sub HtmlTableBuilder()

Dim Wb As Workbook
Dim ws As Worksheet
Dim wsBD As Worksheet
Dim Table As ListObject
Dim TableMail As ListObject
Dim Col As Range
Dim count As Integer
Dim finalTable As Range
Dim result As Variant
Dim values As Variant
Dim dic As Scripting.Dictionary
Dim valCounter As Long
Dim rngHdr As Range
Dim rngDat As Range

Set Wb = Workbooks("MyWorkbook.xlsb")
Set ws = Wb.Worksheets("FL")
Set wsBD = Wb.Worksheets("BD")                                                  'Person database
Set Table = ws.ListObjects("TabMail")                                           'Table to be filtered, copied and pasted to email
Set TableMail = wsBD.ListObjects("People")                                      'Table with names, ID and emails of each person
Set Col = Range("TabMail[PersonID]")                                            'Column with the IDs
Set dic = New Scripting.Dictionary                                              ' Add reference to MS Scripting Runtime

'Extract all person names from an array

 values = ws.Range("G5:G1000").Value2                                           'Value2 is faster than Value
 dic.CompareMode = BinaryCompare                                                'Set the comparison mode to case-sensitive

 For valCounter = LBound(values) To UBound(values)                              'Loop to extract name of persons
    If Not dic.Exists(values(valCounter, 1)) Then                               'Check if the name is already in the dictionary
        dic.Add values(valCounter, 1), 0                                        'Add the new name as key, with a dummy value of 0
    End If
 Next valCounter

 result = dic.Keys                                                              'Extract the dictionary's keys as a 1D array
 count = UBound(result)                                                         'number of persons

'Filter a table by a person name a build a html table with the visible data to send via email
i = 0
 Do While i <= count - 1
    With Range("A4")                                                            'table first cell is A4; count = number of persons
        Col.AutoFilter Field:=7, Criteria1:=result(i)                           'filters table by person i
        Set rng = Table.HeaderRowRange                                          'gets the table header
        Set rngHdr = rng.Resize(, 6)                                            'discards last column
        Set rng = Table.DataBodyRange.SpecialCells(xlCellTypeVisible)           'gets table visible celss
        Set rngDat = rng.Resize(, 6)                                            'discards last column
        Set finalTable = Union(rngHdr, rngDat)                                  'joins header and body
        
        'loop to build html tables
        
        R = 0                                                                   'initializes row counter
            If finalTable.Rows.count > 1 Then                                   'condition to check if filtered table isn't empty
                htmlstr = "<table border=1 style='border-collapse: collapse'>"  'html string start
                For Each rngrow In finalTable.Rows                              'loop rows
                    c = 0: R = R + 1                                            'Initializes row & column counter
                    htmlstr = htmlstr & "<tr>"                                  'html string row beginning
                    For Each rngcol In finalTable.Columns                       'loop columns to each row
                        c = c + 1
                        rngvalue = finalTable(R, c).Value
                         If R = 1 Then                                          'checks if is first row to format as header
                            htmlstr = htmlstr & "<th>" & rngvalue & "</th>"
                        Else                                                    'formats as body row
                            htmlstr = htmlstr & "<td>" & rngvalue & "</td>"
                        End If
                    Next rngcol
                 htmlstr = htmlstr & "</tr>"                                    'html string row ending
                Next rngrow
                htmlstr = htmlstr & "</table>"                                  'html string table ending
            End If
        Debug.Print htmlstr                                                     'Debug to output results to immediate window
    End With
    
    i = i + 1
 
 Loop

End Sub

Ниже приведена таблица (TableMail), которую мне нужно отфильтровать по идентификатору человека. Обратите внимание, что эта таблица связана с другой таблицей на другом листе, где она получает все свои значения, кроме крайнего срока, который необходимо ввести пользователю. Пустые ячейки в последних трех строках на самом деле не пусты, они содержат те же формулы, что и другие ячейки, просто у меня есть условное форматирование пустых ячеек. Формулы аналогичны этой: =IF(MyWorkbook.xlsb!TabMail[@[Project_ID]]="";"";"All")

| Table     | Project_ID    | Task Assigned     | Qtty 1    | Qyy2  | Deadline          | PersonID  |
|---------- |------------   |---------------    |--------   |------ |-----------------  |---------- |
| Project2  | 790403        | All               | 20        | 30    | 06/01/24 13:00    | 104       |
| Project2  | 790536        | All               | 40        | 50    | 06/01/24 13:00    | 104       |
| Project1  | 790539        | All               | 2         | 0     | 06/01/24 13:00    | 104       |
| Project2  | 790661        | All               | 224       | 1,2   | 09/02/24 13:00    | 104       |
| Project1  | 790685        | All               | 1         | 0     | 09/02/24 13:00    | 103       |
| Project1  | 790977        | All               | 0         | 19,8  | 09/02/24 13:00    | 103       |
| Project2  | 799103        | All               | 299       | 4,8   | 09/02/24 13:00    | 103       |
| Project1  | 799372        | All               | 35        | 0,6   | 06/01/24 13:00    | 102       |
| Project1  | 799420        | All               | 0         | 87    | 06/01/24 13:00    | 102       |
| Project1  | 790691        | All               | 56        | 40,2  | 06/01/24 13:00    | 101       |
| Project1  | 790864        | All               | 15        | 0,6   | 09/02/24 13:00    | 101       |
| Project1  | 790907        | All               | 267       | 3,6   | 09/02/24 13:00    | 101       |
|           |               |                   |           |       | xx/xx/24  13:00   |           |
|           |               |                   |           |       | xx/xx/24  13:00   |           |
|           |               |                   |           |       | xx/xx/24  13:00   |           |

В кодексе также упоминается вторая таблица (Люди):

| PersonID  | Name      | MAIL                                  | Step1     | Step2     |
|---------- |---------- |-------------------------------------  |-------    |-------    |
| 95        | Bart      | [email protected]                | ide3      | idv2      |
| 96        | Maggie    | [email protected]                 | ide4      | idv3      |
| 97        | Lisa      | [email protected]                   | ide8      | idv1      |
| 98        | Homer     | [email protected]                 | ide3      | idv5      |
| 99        | Marge     | [email protected]              | ide5      | idv4      |
| 100       | Flanders  | [email protected]             | ide2      |           |
| 101       | Peter     | nomorefunnynames@gmail                | ide1      |           |
| 102       | Lois      | [email protected]             | ide11     |           |
| 103       | Meg       | [email protected]   | ide9      |           |
| 104       | Chris     | [email protected]          | ide6      |           |
| 105       | Brian     | [email protected]                 | ide7      |           |

Вот вывод приведенного выше кода

У меня есть идентификаторы 4 человек, но этот цикл всегда выводит одну и ту же таблицу, а не одну таблицу для каждого человека:

| Project   | Project_ID    | Task Assigned     | Qtty 1    | Qtty 2    | Deadline              |
|---------- |------------   |---------------    |--------   |--------   |-------------------    |
| Project2  | 790403        | All               | 20        | 30        | 06/01/24 13:00:00     |
| Project2  | 790536        | All               | 40        | 50        | 06/01/24 13:00:00     |
| Project1  | 790539        | All               | 2         | 0         | 06/01/24 13:00:00     |
| Project2  | 790661        | All               | 224       | 1,2       | 09/02/24 13:00:00     |

Кажется, проблема заключается в том, что я собираю заголовок и тело таблицы:

Set finalTable = Union(rngHdr, rngDat) 

Я проверил, и rngHdr, и rngDat кажутся в порядке, но FinalTable, кажется, содержит только заголовок, что странно, потому что он выводит проекты предыдущего человека.

Теперь я застрял здесь, не совсем понимая, почему цикл работает только при первом проходе.

Остальная часть кода, похоже, работает нормально, он последовательно фильтрует TableMail по каждому идентификатору человека, и с помощью моего полного кода я получаю необходимую информацию из второй таблицы «Люди» и могу открыть 4 новых сообщения электронной почты, каждое с правильный получатель, тема и приветствие, и я также могу объединить таблицу с остальным текстом электронного письма. Я просто не понимаю, почему он продолжает вставлять одну и ту же первую отфильтрованную таблицу.