如何将Excel数据添加到OFT模板中的表以使用VBA通过电子邮件发送

Question

我正在尝试使用OFT模板将电子邮件发送到电子表格中列出的电子邮件地址，并在电子邮件中包含几列/几行excel数据。

我已经收集了一些有关如何编写代码的想法，并做到了。但是，我遇到了一个问题，即表格未显示相应的数据，关于我的代码在哪里出错的任何想法？

代码将电子邮件发送给正确的用户，并使用正确的表头创建表，只是表中没有数据

我的数据示例：

Email         Company Name   Shortname
a@xyz.com         abc          a
b@xyz.com         smart        sma
a@xyz.com         amex         am
c@xyz.com         buy          by

代码：

Dim OutApp As Outlook.Application

Sub Send_Emails()

    Dim address As String
    Dim tmpTbl As String
    Dim check As Boolean
    Dim i As Long
    Dim lastRow As Long

    check = User_Logged_In
    If check = False Then
        Exit Sub
    Else
    End If

    Set OutApp = Outlook.Application

    i = 2
    lastRow = Sheet1.UsedRange.Rows.Count
    tmpTbl = ""

    'Loop through Spreadsheet
    Do Until i > lastRow
        If i - 1 > 0 And Sheet1.Cells(i, 1) <> Sheet1.Cells(i - 1, 1) Then
            tmpTbl = "<table border=""1"" cellpadding=""2""><tr><td><b><u>Date</u></b></td><td><b><u>Company Name</u></b></td><td><b><u>Shortname</u></b></td></tr>"
repeatLine:
        End If

        address = Sheet1.Cells(i, 1)

        Call SendMail(address, tmpTbl)

        tmpTbl = ""
        i = i + 1
    Loop

    Set OutApp = Nothing
    MsgBox ("Emails have been sent")
End Sub

Public Function SendMail(aTo, aTable)

      On Error GoTo ErrorHandle
      Dim OutMail As Outlook.mailItem
      Dim path As String

      'Set OutMail = OutApp.CreateItem(0)
      path = "Z:\VBA\Email Macro.oft"
      Set OutMail = OutApp.CreateItemFromTemplate(path)

      With OutMail
          .To = aTo
          .BCC = ""
          .BodyFormat = olFormatHTML
          .HTMLBody = Replace(.HTMLBody, "INSERT_TABLE", aTable)
          '.Display
          .Send
      End With

ErrorExit:
      Set OutMail = Nothing
      Exit Function

ErrorHandle:
      MsgBox ("Error Sending Email to " & aTo & ".  Click Ok and the macro will skip this record.")
      Resume ErrorExit

End Function

Function User_Logged_In() As Boolean

    Dim olApp As Object
    On Error Resume Next

    Set olApp = GetObject(, "Outlook.Application")

    On Error GoTo 0
    If Not olApp Is Nothing Then
        User_Logged_In = True
    Else
        MsgBox ("Please Open Outlook.")
        User_Logged_In = False
    End If
End Function