tokerblue
asked on
Excel Mail Merge Runtime Error (5631)
I recently inheirited a Excel spreadsheet that I am having a lot of difficulty with. I'm getting a 5631 runtime error when clicking on a mail merge button. I believe it's opening a .dot file and creating a new document and then merging it with an Access database. The code looks too convoluted for me to fix or correct. Is there an easy way to implement the "save" fix listed on the Microsoft link?
5631 Link:
http://support.microsoft.com/kb/828388
Code in Excel Document:
Dim MyWord As Word.Application, myDoc As Word.Document
Dim wrkJet As Workspace
Dim dbsBackend As Database
Dim rstRep As Recordset
Dim i As Integer
Application.ScreenUpdating = False
'Create Microsoft Jet Workspace object.
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
' Open Database object from saved Microsoft Jet database
Set dbsBackend = wrkJet.OpenDatabase(Range( "Repositor yLocation" ).Value, False)
Set rstRep = dbsBackend.OpenRecordset(" qryFeePage sMailMerge ")
rstRep.MoveLast
rstRep.MoveFirst
For i = 1 To rstRep.RecordCount
If rstRep![tblRepository.Repo sitoryAuto ID] = Range("pricingid").Value And rstRep!ProductPlatform = "MOM" Then
MsgBox ("Select Retail.")
Exit Sub
ElseIf rstRep![tblRepository.Repo sitoryAuto ID] = Range("pricingid").Value Then
Exit For
End If
rstRep.MoveNext
Next
Set MyWord = CreateObject("Word.Applica tion")
MyWord.Application.ScreenU pdating = False
MyWord.Visible = True
Set myDoc = MyWord.Documents.Add(Range ("FeePageT emplateLoc ation").Va lue & Range("FeePageTemplateClie ntRetail") .Value)
With myDoc.MailMerge
.OpenDataSource Name:=Range("RepositoryLoc ation").Va lue, _
ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:="QUERY qryFeePagesMailMerge" _
, SQLStatement:="SELECT * FROM `qryFeePagesMailMerge`", SQLStatement1:=""
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
End With
.Execute Pause:=False
End With
'MyWord.Documents(Range("F eePageTemp late").Val ue).Close
myDoc.Close SaveChanges:=False
MyWord.Application.ScreenU pdating = True
MyWord.ActiveDocument.Prin tPreview
Application.ScreenUpdating = True
5631 Link:
http://support.microsoft.com/kb/828388
Code in Excel Document:
Dim MyWord As Word.Application, myDoc As Word.Document
Dim wrkJet As Workspace
Dim dbsBackend As Database
Dim rstRep As Recordset
Dim i As Integer
Application.ScreenUpdating
'Create Microsoft Jet Workspace object.
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
' Open Database object from saved Microsoft Jet database
Set dbsBackend = wrkJet.OpenDatabase(Range(
Set rstRep = dbsBackend.OpenRecordset("
rstRep.MoveLast
rstRep.MoveFirst
For i = 1 To rstRep.RecordCount
If rstRep![tblRepository.Repo
MsgBox ("Select Retail.")
Exit Sub
ElseIf rstRep![tblRepository.Repo
Exit For
End If
rstRep.MoveNext
Next
Set MyWord = CreateObject("Word.Applica
MyWord.Application.ScreenU
MyWord.Visible = True
Set myDoc = MyWord.Documents.Add(Range
With myDoc.MailMerge
.OpenDataSource Name:=Range("RepositoryLoc
ConfirmConversions:=False,
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="",
Format:=wdOpenFormatAuto, Connection:="QUERY qryFeePagesMailMerge" _
, SQLStatement:="SELECT * FROM `qryFeePagesMailMerge`", SQLStatement1:=""
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
End With
.Execute Pause:=False
End With
'MyWord.Documents(Range("F
myDoc.Close SaveChanges:=False
MyWord.Application.ScreenU
MyWord.ActiveDocument.Prin
Application.ScreenUpdating
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.