Hi,

I'm hoping for a resolution. I read the instructions and I'm pretty comfortable with Mergefields and have all of my documents all aligned and functioning. My problem is when I went to use the VBA code supplied under "Merging by Catalog/Director to E-Mail". I had to manually type into the document because of network security settings and I truly thought I was doing something wrong as I keep getting the below error:




So I decided to copy and paste the code from the tutorial into the Email Merge documents including in the zip file on my personal laptop and I received the same error. What am I doing wrong or is their a piece of code that should/shouldn't be included in the code? Below is the code and I bold the line where the debug button leads me to. Hoping for a resolution. Please and thank you Paul.

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.docx"
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.docx", _
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 = wdSendToNewDocument
.Destination = wdSendToEmail
.MailAddressFieldName = "Recipient"
.MailSubject = "Monthly Sales Stats"
.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

I'm reposted this in another forum so I marking this solved here.