如何用VBA转置Outlook邮件中的HTML表格？调整宏输出格式

我有一个可向各经理发送月度业绩邮件的VBA宏，原代码生成纵向布局的表格，但希望改成横向布局（表头和对应数据分别在同一行）。

原VBA代码：

Sub OutlookEmailsSend()
    
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim lCounter As Long
    Dim endColumnNo As Long
    Dim a As Long
    Dim sFile As String
    
    endColumnNo = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
    
    Set objOutlook = Outlook.Application
   
    For lCounter = 2 To 3
        Set objMail = objOutlook.CreateItem(olMailItem)
        
        objMail.To = Sheet1.Range("B" & lCounter).Value
              
        objMail.Subject = "Sales Summary"
        
        sFile = "Dear,<br><br>Please refer to below table for your performance<br><br><table border=1>"
        
        For a = 1 To endColumnNo
            sFile = sFile & "<tr><td>" & Cells(1, a) & "</td><td>" & Cells(lCounter, a) & "</td></tr>"
        Next
        
        objMail.HTMLBody = sFile
        
        objMail.Display
       
        Set objMail = Nothing
    Next
    
End Sub

原代码生成的纵向表格效果：

Dear,

Please refer to below table for your performance

Name    Tom
Email   sgcjack@163.com
Item    Phone
Sales   123
Bonus   3213

期望的横向表格效果：

Name    Email                   Item     Sales  Bonus
Jack    jacksun@citics.com.hk   Computer 342    23123

修改方案 #

原代码的核心问题是循环每一列时，每次生成一行（表头单元格+对应数据单元格），导致表格纵向排列。要实现横向布局，需调整HTML表格的构建逻辑：先单独生成表头行，再生成对应的数据行。

修改后的完整代码：

Sub OutlookEmailsSend()
    
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim lCounter As Long
    Dim endColumnNo As Long
    Dim a As Long
    Dim sFile As String
    
    endColumnNo = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
    
    Set objOutlook = Outlook.Application
   
    For lCounter = 2 To 3
        Set objMail = objOutlook.CreateItem(olMailItem)
        
        objMail.To = Sheet1.Range("B" & lCounter).Value
        objMail.Subject = "Sales Summary"
        
        ' 初始化HTML内容，开启表格标签
        sFile = "Dear,<br><br>Please refer to below table for your performance<br><br><table border=1>"
        
        ' 构建表头行：将所有表头放入同一<tr>行内
        sFile = sFile & "<tr>"
        For a = 1 To endColumnNo
            sFile = sFile & "<td>" & Sheet1.Cells(1, a).Value & "</td>"
        Next a
        sFile = sFile & "</tr>"
        
        ' 构建数据行：将当前行的所有数据放入同一<tr>行内
        sFile = sFile & "<tr>"
        For a = 1 To endColumnNo
            sFile = sFile & "<td>" & Sheet1.Cells(lCounter, a).Value & "</td>"
        Next a
        sFile = sFile & "</tr>"
        
        ' 关闭表格标签，确保HTML结构完整
        sFile = sFile & "</table>"
        
        objMail.HTMLBody = sFile
        objMail.Display
       
        Set objMail = Nothing
    Next
    
End Sub

关键改动说明 #

1. 拆分表格行构建逻辑：将原有的单循环拆分为表头行和数据行两个独立循环，分别生成横向的表头和数据行
2. 完善HTML结构：补充了</table>闭合标签，避免渲染异常
3. 明确工作表引用：将原代码中的Cells改为Sheet1.Cells，避免因当前工作表切换导致的引用错误

修改后生成的邮件表格将呈现为你期望的横向布局。

内容的提问来源于stack exchange，提问作者Sun Guochen