Mailmerge MailFormat and alighnment issues - vba

Question

I have never used VBA for mailmerge before and recently inherited a docm created a few years ago. My two issues are:
1. How do I get the email to be sent as HTML? Have tried wdMailFormatHTML but it does not work.
2. The data source is in an excel file with headers. The "table" header does not align with the text below. What I want is for the header to adjust width to match the data below. Have tried numerous ways to fix the alignment within the document but to no avail. Also tried to add Column width to the code but I am probably doing it wrong as nothing seem to be working.
Below is the original code. Would appreciate if someone could help.
Sub RunMerge()
Application.ScreenUpdating = False
Dim Doc1 As Document, Doc2 As Document, Doc3 As Document, StrDoc As String
Set Doc1 = ThisDocument
StrDoc = ThisDocument.Path & "\EmailDataSource.doc"
If Dir(StrDoc) <> "" Then Kill StrDoc
With Doc1.MailMerge
If .State = wdMainAndDataSource Then
.Destination = wdSendToNewDocument
.Execute
Set Doc2 = ActiveDocument
End If
End With
Call EmailMergeTableMaker(Doc2)
With Doc2
.SaveAs FileName:=StrDoc, AddToRecentFiles:=False, FileFormat:=wdFormatDocument
StrDoc = .FullName
.Close
End With
Set Doc2 = Nothing
Set Doc3 = Documents.Open(FileName:=Doc1.Path & "\Email Merge Main Document.doc", _
AddToRecentFiles:=False)
With Doc3.MailMerge
.MainDocumentType = wdEMail
.OpenDataSource Name:=StrDoc, ConfirmConversions:=False, ReadOnly:=False, _
LinkToSource:=True, AddToRecentFiles:=False, Connection:="", SQLStatement:="", _
SQLStatement1:="", SubType:=wdMergeSubTypeOther
If .State = wdMainAndDataSource Then
.Destination = wdSendToEmail
.MailAddressFieldName = "Recipient"
.MailSubject = "TrackView follow-up - Missing timesheets/approvals"
.MailFormat = wdMailFormatPlainText
.Execute
End If
End With
Doc3.Close SaveChanges:=False
Set Doc3 = Nothing
Application.ScreenUpdating = True
End Sub
Sub EmailMergeTableMaker(DocName As Document)
Dim oTbl As Table, i As Integer, j As Integer, oRow As Row, oRng As Range, strTxt As String
With DocName
.Paragraphs(1).Range.Delete
Call TableJoiner
For Each oTbl In .Tables
j = 2
With oTbl
i = .Columns.Count - j
For Each oRow In .Rows
Set oRng = oRow.Cells(j).Range
With oRng
.MoveEnd Unit:=wdCell, Count:=i
.Cells.Merge
strTxt = Replace(.Text, vbCr, vbTab)
On Error Resume Next
If Len(strTxt) > 1 Then .Text = Left(strTxt, Len(strTxt) - 2)
End With
Next
End With
Next
For Each oTbl In .Tables
For i = 1 To j
oTbl.Columns(i).Cells.Merge
Next
Next
With .Tables(1)
.Rows.Add BeforeRow:=.Rows(1)
.Cell(1, 1).Range.Text = "Recipient"
.Cell(1, 2).Range.Text = "Data"
End With
.Paragraphs(1).Range.Delete
Call TableJoiner
End With
Set oRng = Nothing
End Sub
Private Sub TableJoiner()
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
With oTbl.Range.Next
If .Information(wdWithInTable) = False Then .Delete
End With
Next
End Sub

Answer 1

Use the HTMLBody property of the mailitem
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Attachments.Add
.body = ""
.CC = ""
.HTMLBody = ""
.subject = ""
.to = emailTo
.Send
End With
On Error GoTo 0
Set OutMail = Nothing

Answer 2

There are at least two potential problems here.
One is that the wdMailFormatHTML parameter will only work with the full version of Outlook, not Outlook Express, etc. etc., i.e. Outlook must be the default email client on the relevant system for this to work. (Other email clients obviously "do" HTML emails - it's just that none of them are known to work with the mechanism Word uses to send HTML emails).
Assuming that you are using Outlook, the second problem is that the email merge process is just emailing the text that has been placed in the Data column in the EmailDataSource.doc, which is the data source for the merge to email. The way that the EmailMergeTableMaker routine works at present, that data will be a tab-separated block of text. Word will probably expand the tabs into some white space, but it will not generate an HTML table. So that is probably the origin of the alignment problem. If so, you need to ensure that that each cell contains a table instead.
It would probably be better to do that by rethinking the way that EmailMergeTableMaker works. The following "quick fix" worked on some sample data here, but I did not test situations where for example the cell is empty.
After this code...
With .Tables(1)
.Rows.Add BeforeRow:=.Rows(1)
.Cell(1, 1).Range.Text = "Recipient"
.Cell(1, 2).Range.Text = "Data"
End With
.Paragraphs(1).Range.Delete
Call TableJoiner
...insert the following:
' you should really move this Dim statement to the top
' of the Sub and merge it with the existing Dim
Dim oCellRng as Range
With .Tables(1)
For i = 2 To .Rows.Count
Set oCellRng = .Cell(i, 2).Range
oCellRng.MoveEnd wdCharacter, -1
oCellRng.ConvertToTable vbTab
Set oCellRng = Nothing
Next
End With
If you are not using Outlook, then you will not be able to use MailMerge directly to create HTML format message, and you obviously won't be able to use the Outlook object model to do it, so I think you then have to think in terms of generating HTML format emails and sending them some other way (e.g. directly via SMTP), but that is a whole other story.
The other way to send emails via Outlook is to automate Outlook, as Thomas Inzina suggests. However, that will also require you to make other changes to the way your merge works.
FWIW the routines you are using come from a tutotial by "macropod" - I don't have a link for it but a search for "macropod Catalogue MailMerge Tutorial" may lead you to it and to other ways to solve this type of problem.