Once a month, a colleague of mine uses a Mail Merge template I created to send out statements to all clients. He's less computer savvy than I am, and his lack of understanding is causing discomfort with him using that Mail Merge tool, but the alternative (manual entry) would be even more prone to human error and be far too time consuming. I've written a macro to automate the process of completing the Mail Merge - the idea is my colleague should be able to click a button from the workbook containing the data and not have to worry about following the step-by-step process or screwing it up again.
The macro I wrote starts working fine, but then it fails in the middle of it, anywhere from record 120 to record 180 (out of around 200 total). I receive an error message on the .Execute command that completes the merge, and that error message is "Run-time error 5535: Word could not finish merging these documents or inserting this database." It is failing on a different record each time I test it, so I don't think it has anything to do with syntax. It seems to be timing out, and I'm not sure how to allow more time to complete the merge. An alternative would be to split it into two macros, with the first handling records 1-100 and the second one handling records 101+, but that is not ideal.
Any advice would be much appreciated!
-KF
Private Sub AutoMM_RentStatement()
If MsgBox("You're about to email Rent Statements to the entire portfolio. Are you sure the balances in the Lease Admin Console are up-to-date and accurate?", vbYesNoCancel, "ALERT: Automate Rent Statements") = vbYes Then
If MsgBox("This could take several minutes. Are you sure you want to do this?", vbYesNo, "ALERT: Automate Rent Statements") = vbYes Then
Sheets("Mail Templates").Range("D20") = "Please wait..."
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Mail Templates").Range("D20").ClearContents
Dim wordapp As Object
Dim worddoc As Word.Document
Dim filepath As String
Dim datasourcefile As String
Dim datasheet As String
Dim subjectline As String
Set wordapp = CreateObject("Word.Application")
datasourcefile = Environ("userprofile") & "\Property Management - Documents\P Drive\Lease Administrator\" & ThisWorkbook.Name
datasheet = "Tenants"
Let filepath = (Environ("userprofile") & "\Property Management - Documents\P Drive\Lease Administrator\Templates\Mailmerge Templates\Rent Statement TEMPLATE.docx")
Set worddoc = wordapp.Documents.Open(filepath)
subjectline = "Rent Statement: " & Format(Sheets("Data Tables").Range("J4"), "mmmm yyyy")
wordapp.ScreenUpdating = False
wordapp.DisplayAlerts = False
worddoc.mailmerge.OpenDataSource Name:=datasourcefile, _
ReadOnly:=True, LinkToSource:=False, _
AddToRecentFiles:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=datasourcefile;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";", _
SQLStatement:="SELECT * FROM `" & datasheet & "$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
With worddoc.mailmerge
.MailAddressFieldName = "Email"
.MailSubject = subjectline
.Destination = wdSendToEmail
.SuppressBlankLines = True
With .datasource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
worddoc.Close savechanges = False
wordapp.DisplayAlerts = True
wordapp.ScreenUpdating = True
wordapp.Quit savechanges = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("Mail Templates").Range("D20").ClearContents
MsgBox "Complete! Rent Statements have been sent."
Else: Exit Sub
End If
Set worddoc = Nothing
Set wordapp = Nothing
Else: Exit Sub
End If
End Sub
Bookmarks