Как создать таблицу из моего текста в VBA

Question

приведенный ниже код извлекает данные из файла Excel, объединяет их по адресам электронной почты и отправляет данные на соответствующие адреса электронной почты.Это работает нормально, но я хочу, чтобы данные выглядели лучше.Есть ли способ сделать таблицу из приведенной ниже информации?

Я бы хотел, чтобы в письме имелся заголовок, подобный приведенному ниже:

|_____|_____|_____|_____|
|_____|_____|_____|_____|

Я видел временные таблицы дляOFT-файл, но не напрямую в Excel, используя следующий код, но я не уверен, как сделать то же самое в этом коде:

tmpTbl = tmpTbl & "<tr><td></td><td></td><td align=""center"">*Company</td></tr></table>"

---

Option Explicit

Sub Consolidate()

    #If Early Then
        Dim emailInformation As New Scripting.Dictionary
    #Else
        Dim emailInformation As Object
        Set emailInformation = CreateObject("Scripting.Dictionary")
    #End If

    GetEmailInformation emailInformation
    SendInfoEmail emailInformation

End Sub

Sub GetEmailInformation(emailInformation As Object)

    Dim rg As Range
    Dim sngRow As Range
    Dim emailAddress As String
    Dim myAppInfo As AppInfo
    Dim AppInfos As Collection

    Set rg = Range("A1").CurrentRegion           ' Assuming the list starts in A1 and DOES NOT contain empty row
    Set rg = rg.Offset(1).Resize(rg.Rows.Count - 1) ' Cut the headings

    For Each sngRow In rg.Rows

        emailAddress = sngRow.Cells(1, 1)

        Set myAppInfo = New AppInfo
        With myAppInfo
            .app = sngRow.Cells(1, 2)            'code
            .version = sngRow.Cells(1, 3)        'Company Name
            .ticker = sngRow.Cells(1, 4)         'Abbreviation
            .group = sngRow.Cells(1, 5)          'group sub group
            .lead = sngRow.Cells(1, 6)           'leader
            .banker = sngRow.Cells(1, 7)         'bank
            .analyst = sngRow.Cells(1, 8)        'analyst
            .otw = sngRow.Cells(1, 9)            'at
            .rating = sngRow.Cells(1, 10)        'rank
            .watchlist = sngRow.Cells(1, 11)     'Comments
            .legal = sngRow.Cells(1, 12)         'notes
            .add = sngRow.Cells(1, 13)           'Date
            .last = sngRow.Cells(1, 14)          'Updated
            .id = sngRow.Cells(1, 15)            'ID
        End With

        If emailInformation.Exists(emailAddress) Then
            emailInformation.item(emailAddress).add myAppInfo
        Else
            Set AppInfos = New Collection
            AppInfos.add myAppInfo
            emailInformation.add emailAddress, AppInfos
        End If

    Next

End Sub

Sub SendInfoEmail(emailInformation As Object)

    Dim sBody As String
    Dim sBodyStart As String
    Dim sBodyInfo As String
    Dim sBodyEnd As String
    Dim emailAdress As Variant
    Dim colLines As Collection
    Dim line As Variant

    sBodyStart = "Hi, please find your info below:" & vbCrLf & vbCrLf

    For Each emailAdress In emailInformation
        Set colLines = emailInformation(emailAdress)
        sBodyInfo = ""
        For Each line In colLines
            sBodyInfo = sBodyInfo & _
                        "Code: " & line.app & vbTab & "Company Name:   " & line.app & vbTab & "abbreviation:   " & line.abbreviation & vbTab & "Group Sub Group:   " & line.group & vbTab & "Bank:   " & line.lead & vbTab & "Analyst:   " & line.analyst & vbTab & "at:   " & line.at & vbTab & "Rank:   " & line.rank & vbTab & "Comments:   " & line.comments & vbTab & "Notes:   " & line.notes & vbTab & "Date:   " & line.add & vbTab & "Updated:   " & line.updated & vbTab & "ID:   " & line.id & vbCrLf
        Next
        sBodyEnd = "Best Regards," & vbCrLf & _
                   "Tom"

        sBody = sBodyStart & sBodyInfo & sBodyEnd
        SendEmail emailAdress, "Info", sBody
    Next

End Sub

Sub SendEmail(ByVal sTo As String _
              , ByVal sSubject As String _
               , ByVal sBody As String _
                , Optional ByRef coll As Collection)

    #If Early Then
        Dim ol As Outlook.Application
        Dim outMail As Outlook.MailItem
        Set ol = New Outlook.Application
    #Else
        Dim ol As Object
        Dim outMail As Object
        Set ol = CreateObject("Outlook.Application")
    #End If

    Set outMail = ol.CreateItem(0)

    With outMail
        .To = sTo
        .Subject = sSubject
        .Body = sBody
        .VotingOptions = "Accept;Reject"
        .Importance = 2

        If Not (coll Is Nothing) Then
            Dim item As Variant
            For Each item In coll
                .Attachments.add item
            Next
        End If

        .Display
        .Send
    End With

    Set outMail = Nothing

End Sub

Answer 1

У меня нет очевидных средств тестирования этого кода, поэтому он может содержать синтаксические ошибки.Я считаю, что я включил достаточно объяснений, чтобы вы могли исправить код в случае необходимости.Если нет, опубликуйте заявление с ошибкой, которую оно дает, и я выясню причину.

Я использовал самый простой HTML.Если вам нужно больше форматирования, я могу дать вам несколько советов.

Html-таблица: <table> ... <table>

Html-строка: <tr> ... </tr>

Html-ячейка: <td> ... </td>

Htmlпараграф: <p> ... </p>

Инициализация sBodyStart и sBodyEnd:

sBodyStart = "<p>Hi, please find your info below:</p>"
sBodyEnd = "<p>Best Regards,<br>Tom</p>"

Добавьте к своим объявлениям:

Dim CellValue As Variant

Замените sbodyInfo = "" на Next с:

sBodyInfo = "<table>"

sBodyInfo = sBodyInfo & "<tr>"
For Each CellValue in Array("Code", "Company Name", "Abbreviation", _
                            "Group Sub Group", "Bank", "Analyst", _
                            "At","Rank","Comments","Notes","Date", _
                            "Updated","ID")
  sBodyInfo = sBodyInfo & "<td>" & CellValue & "</td>"
Next
sBodyInfo = sBodyInfo & "</tr>"

For Each line In colLines

  sBodyInfo = sBodyInfo & "<tr>"
  For Each CellValue in Array(line.app, line.app, line.abbreviation, _
                              line.group, line.lead, line.analyst, _
                              line.at, line.rank, line.comments, _
                              line.notes, line.add, line.updated, line.id)
    sBodyInfo = sBodyInfo & "<td>" & CellValue & "</td>"
  Next
  sBodyInfo = sBodyInfo & "</tr>"

Next

sBodyInfo = sBodyInfo & "</table>"

Answer 2

Вместо установки свойства простого текста Body создайте допустимую строку HTML с таблицей и назначьте ее свойству HTMLBody.