Is there any way to transpose a HTML table using VBA? - html

Question

I have a macro allows me send emails of monthly performance to each manager. Codes are as follow:
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
The macro produce table like this
Dear,
Please refer to below table for your performance
Name Tom
Email sgcjack#163.com
Item Phone
Sales 123
Bonus 3213
However, I would like the table presents as follow
Name Email Item Sales Bonus
Jack jacksun#citics.com.hk Computer 342 23123
Is there any way can do this?

Answer 1

For the sake of better readibility it might be helpful to organize the html creation in a function and to assign the function result to objMail.HTMLBody omitting the loops.
Btw you forgot the closing table tag </table> which wouldn't result in a valid html structure. - Of course, the most direct approach following the original code would be to follow the recommendation in comment to add the <tr>..</tr> tags outside the loop not forgetting the closing </table> tag.
With Sheet1
objMail.HTMLBody = getBody(.Range("A1",.Cells(1,EndColumnNo)),"Dear xx")`
End With
The help function getBody() joins (a) headers and (b) table data based on a (c) clearly defined table structure.
Note: You can play around and change that definition to a more sophisticated html code with separate header tags, too..
Function getBody(rng As Range, _
Optional greetings As String = "", _
Optional HeaderList As String = "Name,Email,Item,Sales,Bonus")
Const Blanks As String = " "
'a) get headers
Dim headers As String
headers = " <td>" & Replace(HeaderList, ",", "</td><td>") & "</td>"
'b) join table data "<td>..</td>"
Dim data As String
data = Blanks & _
Join(rng.Parent.Evaluate("""<td>""&" & rng.Address(0, 0) & " & ""</td>""") _
, vbNewLine & Blanks)
'c) define table structure
Dim tags()
tags = Array(greetings, _
"<table border='1'>", _
" <tr>", headers, " </tr>", _
" <tr>", data, " </tr>", _
"</table>")
'd) return joined function result
getBody = Join(tags, vbNewLine)
End Function