I have a macro that merges a Word document with an Excel data source. The macro runs fine, and even creates separate output files, but does not release the connection to the Excel data source when it finishes. Here's the code. I know just enough about VB to be dangerous. Can you help?
-------------------------
' GenerateDocuments Macro
'
On Error GoTo Bye:
Dim DesktopPath As String
'Set the user's desktop as path
DesktopPath = Environ("UserProfile") & "\Desktop\PAFMerge\"
ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
ActiveDocument.MailMerge.OpenDataSource Name:= _
DesktopPath & "PAF Source.xlsx", ConfirmConversions _
:=True, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Jack3411\Desktop\PAFMerge\PAF Source.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Datab" _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
'Begin the mail merge
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
'Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
DocNum = DocNum + 1
ActiveDocument.SaveAs (DesktopPath & "PAF_" & DocNum & ".doc")
ActiveDocument.Close
'Move the selection to the next section in the document
Application.Browser.Next
Next i
'Prompt user when done
MsgBox "Your documents have been generated."
Bye:
End Sub
-------------------------
' GenerateDocuments Macro
'
On Error GoTo Bye:
Dim DesktopPath As String
'Set the user's desktop as path
DesktopPath = Environ("UserProfile") & "\Desktop\PAFMerge\"
ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
ActiveDocument.MailMerge.OpenDataSource Name:= _
DesktopPath & "PAF Source.xlsx", ConfirmConversions _
:=True, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Jack3411\Desktop\PAFMerge\PAF Source.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Datab" _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
'Begin the mail merge
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
'Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
DocNum = DocNum + 1
ActiveDocument.SaveAs (DesktopPath & "PAF_" & DocNum & ".doc")
ActiveDocument.Close
'Move the selection to the next section in the document
Application.Browser.Next
Next i
'Prompt user when done
MsgBox "Your documents have been generated."
Bye:
End Sub
