VBA from Excel to Word (Mail Merge) - Hosted on SharePoint

[agent_maxine]

Dear Mr. Excel,
First of all, thank you kindly for the wealth of information stored in this forum - it has helped me tremendously in my recent projects!

I am trying to extract cell values from Excel to complete a Word template. I have completed Mail Merge tags on Word and it works beautifully... when the files are in local drive.
Unfortunately our shared files are hosted on SharePoint... It appears that Mail Merge is not possible when the Excel/Word files are hosted there.

I had this idea to perhaps copy both the Excel/Word files onto Windows Temp folder*, complete Mail Merge, copy the Merged Word file back into initial SharePoint folder, then delete the copies from Temp folder. How do I structure the VBA script to accomplish this?

*(or another folder within local drive where the file path remains the same for all users - for example, path to my Desktop includes my specific Company ID and thus cannot use it for everyone. Unless there is a way around it!)

I am currently looking at this past discussion and would like to build around this:
https://www.mrexcel.com/forum/gener...ons/975319-excel-vba-run-mail-merge-word.html

 

[Macropod]

If you're using code based on post #17 , it won't find any open Word documents because it's running its own Word session, which it instantiates via:
Dim WordApp As New Word.Application
and isolates it from any other Word sessions you might already have running. To do what you want, you'd need to delete 'New' and add code to test whether Word is already running before trying to create a new Word session and close & save any existing open documents, which you'd do by replacing 'With WordApp' with:

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
  Set WordApp = CreateObject("Word.Application")
  On Error GoTo 0
  If WordApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
End If
On Error GoTo 0

With WordApp
  While .Documents.Count > 0
    .Documents(1).Close SaveChanges:=True
  Wend

 

[agent_maxine]

Ah, ok that makes sense. I inserted your codes and it worked - thank you!
Am wondering... is there a way to ensure that no orphaned Word sessions are left behind after running the MailMerge scripts? The scripts quit Word as intended, but it does not seem to terminate all the WINWORD.exe sessions. I have the following lines at the end of my codes:

wordApp.Quit
Set wordDoc = Nothing: Set wordApp = Nothing

 

[Macropod]

Am wondering... is there a way to ensure that no orphaned Word sessions are left behind after running the MailMerge scripts? The scripts quit Word as intended, but it does not seem to terminate all the WINWORD.exe sessions.

With the modified code there shouldn't be any 'orphaned' Word sessions, as it only creates a new one if Word wasn't already running.

Personally, I wouldn't be comfortable with:

  While .Documents.Count > 0
  .Documents(1).Close SaveChanges:=True
  Wend

as that may result in unwanted edits being saved, unwanted files being created, or wanted new files saved with the wrong names and to the wrong locations. Conversely, if you don't use that code, forcing Word to close an already-running Word session may result in lost work. My preferred approach would be to test whether Word is already running, leave any open files alone, and only quit Word if your code starts it. For example:

Sub Generate_Document1_Document2()
Dim WordApp As Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Sheet As Worksheet, SheetName As String, DataSource As String, r As Long, bQuit As Boolean
Dim Document1Path As String, Document2Path As String
Dim Document1Name As String, Document2Name As String

With ActiveWorkbook
    DataSource = .FullName
    Document1Path = .Path & "\Document1.docx"
    Document2Path = .Path & "\Document2.docx"
    SheetName = .Sheets("Transfer").Name
    Document1Name = .Sheets("Transfer").Range("U2").Text & " - Document1"
    Document2Name = .Sheets("Transfer").Range("U2").Text & " - Document2"
End With

bQuit = False
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
    Set WordApp = CreateObject("Word.Application")
    On Error GoTo 0
    If WordApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
    End If
    bQuit = True
End If
On Error GoTo 0

With WordApp
    If bQuit = True Then .Visible = False
    .DisplayAlerts = wdAlertsNone
    
    Set WordDoc = .Documents.Open(Document1Path, AddToRecentFiles:=False, ReadOnly:=True)
    With WordDoc
        'Select Data Source and Complete Mail Merge
        With .Mailmerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", WritePassWordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, SubType:=wdMergeSubTypeAccess, _
                Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
                "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & SheetName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        Document1Path = .Path & "\"
        .Close SaveChanges:=False
    End With
    With .ActiveDocument
        For Each Tbl In .Tables
            With Tbl
                .AllowAutoFit = False
                For r = .Rows.Count To 1 Step -1
                    With .Rows(r)
                        If Len(.Range.Text) = .Cells.Count * 2 + 2 Then .Delete
                    End With
                Next
            End With
        Next
        .SaveAs Filename:=Document1Path & Document1Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    
    Set WordDoc = .Documents.Open(Document2Path, AddToRecentFiles:=False, ReadOnly:=True)
    With WordDoc
        'Select Data Source and Complete Mail Merge
        With .Mailmerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", WritePassWordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, SubType:=wdMergeSubTypeAccess, _
                Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
                "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & SheetName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        Document2Path = .Path & "\"
        .Close SaveChanges:=False
    End With
    .ActiveDocument.SaveAs Filename:=Document2Path & Document2Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close SaveChanges:=False
    .DisplayAlerts = wdAlertsAll
    If bQuit = True Then .Quit
End With

Set WordDoc = Nothing: Set WordApp = Nothing
End Sub

However, unless you want your code to be able to access an already-open document, this isn't really achieving anything more than the code in post #17 would achieve by inserting:
.Quit
after:
.DisplayAlerts = wdAlertsAll

 

[agent_maxine]

Thank you kindly for your good suggestion. The idea of closing all Word files (before MailMerge) came about after realizing that users were repeating the script whenever their data entry changes, without remembering to close the previously MailMerged file. As you can imagine, it was creating errors... and even though you close all the Word windows, there were still orphaned sessions in the background that prevented the script from running smoothly. Will have to run more tests to drill down the cause of error, and determine the balance between user training and coding. I fully agree with you that closing all Word files blindly may cause unwanted saving.

I also came across a very peculiar error. When the document is displayed after MailMerge, some of the fields didn't seem to be updated (i.e. taking values from previous entry, even though I'm saving the source Excel file prior to MailMerging). But when you close/save the merged Word document, the fields are populated correctly. Have you heard of a case like this?

 

[Macropod]

The only way a previously-merged document would be open is because someone opened it after the merge completed, since the merge closes the output document. I can see that you might want to force the closure of such documents to avoid errors, and I could modify the code to do that.

Since mergefields don't survive a mailmerge, I can only conclude you're looking at the mailmerge main document with a preview of the data, not the output document (which the code closes).

 

[agent_maxine]

Yes that is exactly the scenario... Often it is during the review process where users realize updated entry is needed in the source system - and generally they don't think about closing the document they were viewing. I was thinking of instructing users to close all other Word/Excel files when working with this script, and have the code to close all Word files anyways. What are your thoughts on this approach?

It is very possible that I was looking at it during the preview stage. How can I ask it to open the file after MailMerge is completed/file closed? I tried the following and it didn't work:

Set wordDoc = wordApp.Documents.Open(Document2Path & Document2Name & ".docx", AddToRecentFiles:=False, Visible:=True)

 

[Macropod]

Try the following. If the document from a previous merge is open, it will be closed (since it's about to be overwritten). Other documents & workbooks will be left alone. That is far safer than closing all Word files through code.

Sub Generate_Document1_Document2()
Dim WordApp As Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Sheet As Worksheet, SheetName As String, DataSource As String, r As Long, bQuit As Boolean
Dim Document1Path As String, Document1Name As String
Dim Document2Path As String, Document2Name As String

With ActiveWorkbook
    DataSource = .FullName
    Document1Path = .Path & "\Document1.docx"
    Document2Path = .Path & "\Document2.docx"
    SheetName = .Sheets("Transfer").Name
    Document1Name = .Sheets("Transfer").Range("U2").Text & " - Document1"
    Document2Name = .Sheets("Transfer").Range("U2").Text & " - Document2"
End With

bQuit = False
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
    Set WordApp = CreateObject("Word.Application")
    On Error GoTo 0
    If WordApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
    End If
    bQuit = True
End If
On Error GoTo 0

With WordApp
    If bQuit = True Then .Visible = False
    .DisplayAlerts = wdAlertsNone
    
    Set WordDoc = .Documents.Open(Document1Path, AddToRecentFiles:=False, ReadOnly:=True)
    With WordDoc
        'Select Data Source and Complete Mail Merge
        With .Mailmerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", WritePassWordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, SubType:=wdMergeSubTypeAccess, _
                Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
                "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & SheetName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        Document1Path = .Path & "\"
        .Close SaveChanges:=False
    End With
    
    For Each WordDoc In .Documents
        If WordDoc.FullName = Document1Path & Document1Name & ".docx" Then
            WordDoc.Close False: Exit For
        End If
    Next
    
    With .ActiveDocument
        For Each Tbl In .Tables
            With Tbl
                .AllowAutoFit = False
                For r = .Rows.Count To 1 Step -1
                    With .Rows(r)
                        If Len(.Range.Text) = .Cells.Count * 2 + 2 Then .Delete
                    End With
                Next
            End With
        Next
        .SaveAs Filename:=Document1Path & Document1Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close SaveChanges:=False '*
    End With
    
    Set WordDoc = .Documents.Open(Document2Path, AddToRecentFiles:=False, ReadOnly:=True)
    With WordDoc
        'Select Data Source and Complete Mail Merge
        With .Mailmerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", WritePassWordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, SubType:=wdMergeSubTypeAccess, _
                Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
                "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & SheetName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        Document2Path = .Path & "\"
        .Close SaveChanges:=False
    End With
    
    For Each WordDoc In .Documents
        If WordDoc.FullName = Document2Path & Document2Name & ".docx" Then
            WordDoc.Close False: Exit For
        End If
    Next
    
    .ActiveDocument.SaveAs Filename:=Document2Path & Document2Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close SaveChanges:=False '*
    
    .DisplayAlerts = wdAlertsAll
    If bQuit = True Then .Quit '*
End With

Set WordDoc = Nothing: Set WordApp = Nothing
End Sub

If you want to keep Word running with the output documents open, comment-out or delete the three lines ending with '*

 

[agent_maxine]

Dear Paul, thank you kindly for your revision - much appreciated as usual!

I ran the codes on a different computer and now getting a different set of errors (that I hadn't encountered before). It appears that when there is an existing file, it is not able to overwrite it.
1. There was an existing Word document with the same DocPath & DocName (i.e. MailMerge was done on a file that had been generated previously.)
2. No Word file was open (I had manually closed all the sessions through Task Manager).

"Microsoft Excel is waiting for another application to complete an OLE action."

When I manually terminated the active Word session through Task Manager, I got this error:
"Run-time error '-2147023170 (800706be)': Automation Error. The remote procedure call failed."

Debugging highlights this line:

.Execute Pause:=False

This is quite curious since the script would overwrite the existing files automatically on my old computer. (It runs as intended for documents that are being MailMerged for the first time.)

 

[Macropod]

I can't see that the error involves the overwriting of files, since that isn't what the message:
"Microsoft Excel is waiting for another application to complete an OLE action."
or the line:
.Execute Pause:=False
concern. Since you're working on SharePoint it may reflect someone else having the workbook open.

You might try changing the two instances of:
ReadOnly:=False
in the OpenDataSource lines to:
ReadOnly:=True

 

[agent_maxine]

It turns out that I'm not getting the same error today haha. Perhaps this new computer took a while to create/store memories or something. I am, however, seeing more interesting results...

1. Word Files Open prior to running MailMerge: Previously Merged File (file name = DocName as defined in Sub) + Other Random File
Previously Merged File remains open. Newly MailMerged file also remains open (file name = "Form Letters#"). When I close the previously merged file and reopen it, it is replaced with the content of Other Random File in its entirety.

2. Word Files Open prior to running MailMerge: Other Random File / Closed: Previously Merged File (file name = DocName as defined in Sub)
Other Random File becomes closed. Newly MailMerged file remains open (file name = "Letters#"). Previously Merged File also opens (file name = DocName) but its content is replaced with that of Other Random File. When I close/reopen Previously Merged File, it still retains the content from Other Random File.

3. No Word File Open prior to running MailMerge (Word Application Closed). Previously Merged File exists (file name = DocName as defined in Sub)
Works as intended.

4. No Word File Open prior to running MailMerge (Word Application Closed). No Previously Merged File exists (file name = DocName as defined in Sub)
Works as intended.

This is the code I'm using (I've gone back to using 1 MailMerge Document, and calling this function multiple times in a different sub for Document #2 ):

Sub MailMerge_Document(DocTemplate As String, DocName As String, DocPath As String)
'Complete Word Documents (Template) by Using Data Entries in Excel
'Reference Required: VBE > Tools > References > Microsoft Word 15.0 Object Library

Dim WordApp As Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Sheet As Worksheet, SheetName As String, DataSource As String, r As Long, bQuit As Boolean

With ActiveWorkbook
    DataSource = .FullName
    SheetName = .Sheets("Transfer").Name
End With

'Close if a Previously MailMerged Document is Open
bQuit = False
On Error Resume Next

Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
    Set WordApp = CreateObject("Word.Application")
    On Error GoTo 0
    If WordApp Is Nothing Then
        MsgBox "Cannot Start MS Word.", vbCritical
        Exit Sub
    End If
    bQuit = True
End If

On Error GoTo 0

With WordApp
    If bQuit = True Then .Visible = False
    .DisplayAlerts = wdAlertsNone

    For Each WordDoc In .Documents
        If WordDoc.FullName = DocPath & DocName & ".docx" Then
            WordDoc.Close False: Exit For
        End If
    Next

'Select Data Source and Complete Mail Merge
    Set WordDoc = .Documents.Open(DocTemplate, AddToRecentFiles:=False)
    With WordDoc
        With .MailMerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .OpenDataSource Name:=DataSource, ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:="", _
                PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
                SubType:=wdMergeSubTypeAccess, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=DataSource;Mode=Read;" & _
                "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & SheetName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        DocTemplate = DocPath & "\"
        .Close SaveChanges:=False
    End With
    
    For Each WordDoc In .Documents
        If WordDoc.FullName = DocPath & DocName & ".docx" Then
            WordDoc.Close False: Exit For
        End If
    Next
    
    With .ActiveDocument
        For Each Tbl In .Tables
            With Tbl
                .AllowAutoFit = False
                For r = .Rows.Count To 1 Step -1
                    With .Rows(r)
                        If Len(.Range.Text) = .Cells.Count * 2 + 2 Then .Delete
                    End With
                Next
            End With
        Next
        .SaveAs FileName:=DocPath & DocName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    .DisplayAlerts = wdAlertsAll
    'If bQuit = True Then .Quit
End With

'WordApp.Quit
Set WordDoc = Nothing: Set WordApp = Nothing

End Sub

I also wanted to open the merged file at the end... but simply adding this line after .SaveAs FileName doesn't seem to cut it. Would I need to start another "With WordApp ... End With"?

Set WordDoc = .Documents.Open(DocPath & DocName & ".docx", AddToRecentFiles:=False)