如何在Excel VBA中创建表格以发送电子邮件？

Sub CreateTableAndSendEmail()
    Dim rng As Range
    Dim tbl As ListObject
    Dim mailObj As Object
    
    ' 创建一个新的工作表
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TableSheet"
    
    ' 在新的工作表中创建一个表格
    Set rng = Range("A1:D5") ' 设置表格的范围
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes) ' 创建表格
    
    ' 填充表格数据
    tbl.DataBodyRange.Cells(1, 1).Value = "姓名"
    tbl.DataBodyRange.Cells(1, 2).Value = "年龄"
    tbl.DataBodyRange.Cells(1, 3).Value = "性别"
    tbl.DataBodyRange.Cells(1, 4).Value = "城市"
    
    tbl.DataBodyRange.Cells(2, 1).Value = "张三"
    tbl.DataBodyRange.Cells(2, 2).Value = 25
    tbl.DataBodyRange.Cells(2, 3).Value = "男"
    tbl.DataBodyRange.Cells(2, 4).Value = "北京"
    
    ' 发送电子邮件
    Set mailObj = CreateObject("Outlook.Application")
    With mailObj.CreateItem(0)
        .To = "recipient@example.com" ' 设置收件人邮箱地址
        .Subject = "表格数据" ' 设置邮件主题
        .HTMLBody = RangetoHTML(rng) ' 将表格转换为HTML格式并设置为邮件正文
        .Display ' 显示邮件
    End With
    
    ' 清理对象
    Set rng = Nothing
    Set tbl = Nothing
    Set mailObj = Nothing
End Sub

Function RangetoHTML(rng As Range) As String
    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
    
    ' 将临时工作簿保存为HTML文件
    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
    
    ' 读取HTML文件内容
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    
    ' 关闭临时工作簿和文件流
    ts.Close
    TempWB.Close savechanges:=False
    Kill TempFile
    
    ' 清理对象
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function