Hey Paul,
My apologies was out of office for a few days, hence could not reply earlier.
You are right, I may not need the EmailMergeTableMaker macro. All I am trying to do is send out a standard word document to around 300 users. I have an Excel file with 3 field setup; First, Last and EMail. The only merge field that I am using in my MailMerge Word doc is "First". Rest of the word doc is standard.
I also want to insert a delay timer between each email message that is sent out, say like 90 seconds. Given my limited knowledge, I tried amalgamating the above code with the Catalogue Mail Merge code, per below. I did this because i need the timer. Per the catalogue tutorial, all my data is in the "Email Merge Main Document.doc" and data source is in Catalogue Merge Data.xls, all saved in the same folder along with other documents that were in the catalogue mail merge zip.
The below macro fails in the EmailMergeTableMaker function on the ".Paragraphs(1).Range.Delete" line; saying "Object variable or with block variable not set".
Thanks a ton for helping out Paul.
Regards,
Nevin.
Code:
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
j = .Tables(1).Rows.Count - 1
.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 = wdSendToNewDocument
.Destination = wdSendToEmail
.MailAddressFieldName = "Recipient"
.MailSubject = "Monthly Sales Stats"
.MailFormat = wdMailFormatHTML
For i = 1 To j
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
End With
.Execute Pause:=False
Call Pause(90)
Next i
End If
End With
Doc3.Close SaveChanges:=False
Set Doc3 = Nothing
Application.ScreenUpdating = True
End Sub
Public Function Pause(Delay As Long)
Dim Start As Long
Start = Timer
If Start + Delay > 86399 Then
Start = 0: Delay = (Start + Delay) Mod 86400
Do While Timer > 1
DoEvents ' Yield to other processes.
Loop
End If
Do While Timer < Start + Delay
DoEvents ' Yield to other processes.
Loop
End Function
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