VBA Script to give a list of Mail Merges

I need a script for Access to give me a list of Mail Merge data and write to a table in Access.

Below is my example for the Excel documents when they have external connections:
Dim oFSO As FileSystemObject, oFILE As File
Dim xlApp As Excel.Application, xlBook As Workbook, xlConn As WorkbookConnection
Dim xlRange As Range
Dim rst As Recordset

Set oFSO = New FileSystemObject
Set xlApp = New Excel.Application: xlApp.Visible = True
Set rst = CurrentDb.OpenRecordset("DATA_LINK")

For Each oFILE In oFSO.GetFolder(CurrentProject.Path & "\excel").Files
    If oFILE.Name <> "thumbs.db" Then
        Set xlBook = xlApp.Workbooks.Open(oFILE.Path, False)
        For Each xlConn In xlBook.Connections
            If xlConn.Ranges.Count <> 1 Then
                Stop
            End If
            
            rst.AddNew
            rst!WORKBOOK_PATH = oFILE.Path
            rst!DATA_LINK_NAME = xlConn.Name
            rst!COMMAND_TEXT = Replace(Replace(Replace(xlConn.ODBCConnection.CommandText, vbCrLf, " "), vbCr, " "), vbLf, " ")
            rst!RANGE_WORKSHEET = xlConn.Ranges(1).Worksheet.Name
            rst!RANGE_ADDRESS = xlConn.Ranges(1).Address
            rst.Update
        Next xlConn
        xlBook.Close False
    End If
Next oFILE

End Function

Open in new window

LVL 5
TONY TAYLORAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robert ShermanOwnerCommented:
If what you are trying to do is fashion some code similar to what you show as an example for Excel, which is to say iterate over a folder of Word documents and for any that are mail merge documents with an external data source, you want to record the data-source information into an Access table..

You would go through the documents in a very similar way as you are doing in the Excel example.  

For each Word document, you would check for the property MailMerge.DataSource.Name   If it is an empty string, (if it = ""), then there is no external datasource for that document.  

Here's Microsoft's documentation on the MailMerge.DataSource property:

https://msdn.microsoft.com/EN-US/library/office/ff838518.aspx

The resulting code shouldn't be too far off from what you have already when dealing with Excel.
0
GrahamSkanRetiredCommented:
A Word mail merge document only has one datasource, so the question is a bit confusing. However if Robert Sherman has interpreted your problem correctly, then this code might be near to what you are looking for
Option Compare Database
Option Explicit

Sub ListDataSources(strFolder As String)
Dim wdApp As Word.Application 'early binding. So set a reference (Tools/References)to Microsoft Word Object Library
Dim wdDoc As Word.Document
Dim rst As DAO.Recordset
Dim strFileName As String
Dim bNewInstance As Boolean

'get Word Application object, but try to ensure that only one instance of the Word application is running
On Error Resume Next 'supress error handling
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0 'resume default error handling
If wdApp Is Nothing Then ' getobject failed
    Set wdApp = CreateObject("Word.Application")
    bNewInstance = True
End If

Set rst = CurrentDb.OpenRecordset("DATA_LINK")

strFileName = Dir(strFolder & "\.doc*")
Do Until strFileName = ""
    Set wdDoc = wdApp.Documents.Open(strFolder & "\" & strFileName)
    With wdDoc.MailMerge
        If .MainDocumentType <> wdNotAMergeDocument Then
            rst.AddNew
            rst!document_PATH = wdDoc.Path
            With .DataSource
                rst!Connection = .ConnectString
                rst!datasourcename = .Name
                rst!QueryString = .QueryString
                rst!TableName = .TableName
            End With
            rst.Update
            wdDoc.Close wdDoNotSaveChanges
        End If
    End With
    strFileName = Dir$()
Loop

If bNewInstance Then
    'safe to close application
    wdApp.Quit
End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TONY TAYLORAuthor Commented:
So, when I asked this question, I was tapping out on brain power and actually wanted someone to write the next function for me like @GrahamSkan has provided.  I wrote the first function, but didn't have the brain power to continue last night.

@Robert Sherman definitely has points so I will award partial credit.  Thank you both.  I will use a modification of the code from @GrahamSkan.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.