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



## agent_maxine (Aug 23, 2017)

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 (Aug 23, 2017)

For SharePoint automation, see 'Using Check Out and Check In' at:
Using Microsoft Windows SharePoint Services with the Microsoft Office System
For mailmerge automation you may also be interested in:
Word 2007/2010 Mail Merge to save to individual PDF files
Automating Word Mail Merge with Excel 2010 VBA


----------



## agent_maxine (Aug 24, 2017)

Dear Paul, thank you for your kind replies! I modified a few details to simply the codes.
- Using "ThisWorkbook.Path" as both Excel and Word documents are saved in the same SharePoint folder.
- All the information feeding to Mail Merge is contained in Row #2  of the sheet named "Transfer".

1. I now have an interesting situation. Thhelpe Word template is 7 pages and it is mail-merged successfully... at  first. Then those 7 pages are pasted a few times more and it becomes a  87-page document. And the rest of document (Page 8~87) is a blank  template, without any mail merge. I wonder if it's doing some sort of a  loop?
2. I have included the Checkout/Checkin code as such. Is this the right way to do it?

Thank you so much -- you've solved my week-long problem!


```
Sub Excel_to_Word()

Dim Sheet As Worksheet, wsName As String, dataSrc As String, wordPath As String, excelPath As String
Dim wordApp As New Word.Application, wordDoc As Word.Document

dataSrc = ActiveWorkbook.FullName
excelPath = ThisWorkbook.Path & "\Quote Binder Declarations.xlsm"
wordPath = ThisWorkbook.Path & "\FORM-QUOTE (CVBR Excel).docx"

If Workbooks.CanCheckOut("Quote Binder Declarations.xlsm") = True Then
    Workbooks.CheckOut docCheckOut
Else
    MsgBox "This document cannot be checked out."
End If

wordApp.DisplayAlerts = wdAlertsNone
wsName = Sheets("Transfer").Name

Set wordDoc = wordApp.Documents.Open(wordPath, AddToRecentFiles:=False)
Call Mail_Merge(wordDoc, dataSrc, wsName)

wordApp.DisplayAlerts = wdAlertsAll
wordApp.Visible = True

Set wordDoc = Nothing
Set wordApp = Nothing

If Workbooks("Quote Binder Declarations.xlsm").CanCheckIn = True Then
        Workbooks("Quote Binder Declarations.xlsm").CheckIn SaveChanges:=True
Else
        MsgBox "This document cannot be checked in."
End If

End Sub

Sub Mail_Merge(wordDoc As Word.Document, dataSrc As String, wsName As String)

With wordDoc
    'Select Data Source and Complete Mail Merge
    With .Mailmerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource Name:=dataSrc, 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=dataSrc;Mode=Read;" & _
        "Extended Properties=""HDR=YES;IME", SQLStatement:="SELECT * FROM `" & wsName & "$`", SQLStatement1:=""

        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
    .Execute Pause:=False
    .Destination = wdSendToNewDocument
  
    End With
    .Close SaveChanges:=False
End With

End Sub
```


----------



## agent_maxine (Aug 24, 2017)

Also, how do I clean up this code to eliminate duplication? I imagine using ActiveWorkbook.FullName then having the full name of Excel document is unnecessary... Same with wsName somehow?


----------



## Macropod (Aug 24, 2017)

There's a few things I don't understand about your code. For example:
• you define and populate excelPath, but then never use it;
• your code references the ActiveWorkbook.FullName for dataSrc, but ThisWorkbook.Path & "\FORM-QUOTE (CVBR Excel).docx" for wordPath. Why ActiveWorkbook for dataSrc and ThisWorkbook for wordPath & excelPath?;
• You check out & in 'Quote Binder Declarations.xlsm' but never use it. If I were to use such code, I'd put all the wordapp code inside the 'True' condition of the first If test:

```
If Workbooks.CanCheckOut("Quote Binder Declarations.xlsm") = True Then
    Workbooks.CheckOut docCheckOut
    wsName = Sheets("Transfer").Name
    With wordApp
        .DisplayAlerts = wdAlertsNone
        Set wordDoc = .Documents.Open(wordPath, AddToRecentFiles:=False)
        Call Mail_Merge(wordDoc, dataSrc, wsName)

        .DisplayAlerts = wdAlertsAll
        .Visible = True
    End With
    Set wordDoc = Nothing: Set wordApp = Nothing
Else
    MsgBox "This document cannot be checked out."
End If
```
This, of course, assumes you actually need the checkout. If so, it precludes any attempts to execute the merge when the workbook can't be checked out.

You mention all the merge data being on only one row of the workbook, but the merge is generating multiple sets of pages for empty records. That indicates your data source has 'in-use' rows that are empty. Deleting those empty rows and saving the workbook before executing the merge should solve that; otherwise add some logic to your SQL code to exclude empty records.


----------



## agent_maxine (Aug 24, 2017)

Dear Paul,

Thank you for your observations. Most of the inconsistency comes from my (rather unsuccessful) attempt to combine elements from various sets of codes.
- ExcelPath: You're right - I do not need this variable. Deleted it.
- Changed both to ActiveWorkbook
- Strangely enough... when I automated Mail Merge from SharePoint via VBA, it generated the Word file successfully without having to Checkout/Checkin and/or copy/paste the files onto Local Drive.
- I reviewed the Transfer sheet again and yes, there were some data in rows below. The problem was solved after deleting the extra data!

Questions:
- I would like to assign a default value for the name of mail-merged Word file as Cell J2 of "Transfer" sheet. How do I go about doing this?
- How do I include logic to SQL codes to exclude empty records? Or delete the records after Row #2  on "Transfer" sheet?


```
Sub Excel_to_Word()

Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document

DataSource = ActiveWorkbook.FullName
WordPath = ActiveWorkbook.Path & "\FORM-QUOTE (CVBR).docx"

WordApp.DisplayAlerts = wdAlertsNone
wsName = Sheets("Transfer").Name

Set WordDoc = WordApp.Documents.Open(WordPath, AddToRecentFiles:=False)
Call Mail_Merge(WordDoc, DataSource, wsName)

WordApp.DisplayAlerts = wdAlertsAll
WordApp.Visible = True

Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

Sub Mail_Merge(WordDoc As Word.Document, DataSource As String, wsName As String)

With WordDoc

    'Select Data Source and Complete Mail Merge
    With .Mailmerge
        .MainDocumentType = wdFormLetters
        .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 `" & wsName & "$`", SQLStatement1:=""

        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
    
    .Execute Pause:=False
    .Destination = wdSendToNewDocument
  
    End With
    .Close SaveChanges:=False

End With

End Sub
```


----------



## Macropod (Aug 24, 2017)

I'd be inclined to use something like:

```
Sub Excel_to_Word()
Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, StrName As String

With ActiveWorkbook
  DataSource = .FullName
  WordPath = .Path & "\FORM-QUOTE (CVBR).docx"
  wsName = .Sheets("Transfer").Name
  StrName = .Sheets("Transfer").Range("J2").Text
End With

With WordApp
  .Visible = False
  .DisplayAlerts = wdAlertsNone
  Set WordDoc = .Documents.Open(WordPath, AddToRecentFiles:=False)
  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 `" & wsName & "$`", SQLStatement1:=""
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    .Close SaveChanges:=False
  End With
  With .ActiveDocument
    .SaveAs Filename:=WordPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    ' and/or:
    .SaveAs Filename:=WordPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close SaveChanges:=False
  End With
  .DisplayAlerts = wdAlertsAll
  .Quit
End With
Set WordDoc = Nothing: Set WordApp = Nothing
End Sub
```
Note that this saves the output and as a document and/or a PDF, as well as quitting Word when done. If you want the document to remain open with the output document visible, change:
.Visible = False
to:
.Visible = True
and delete or comment out the second:
.Close SaveChanges:=False
and:
.Quit


----------



## agent_maxine (Aug 25, 2017)

WOW. Thank you so much!
Now I'm starting to build up to customize the Word document further... I would like to delete empty rows that have been populated in a table (Macro to delete all empty rows from all tables - looks like it's one of yours actually!). It works beautifully except the table column width has expanded to 23" haha (the original Excel cell where the data is stored has long column width). How can I tell it to keep the table format as is?


```
Sub Excel_to_Word()
Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, StrName As String

With ActiveWorkbook
    DataSource = .FullName
    WordPath = .Path & "\QUOTE.docx"
    wsName = .Sheets("Transfer").Name
    StrName = .Sheets("Transfer").Range("W2").Text & " - " & .Sheets("Transfer").Range("B2").Text
End With

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    
    Set WordDoc = .Documents.Open(WordPath, AddToRecentFiles:=False)
    
    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 `" & wsName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        .Close SaveChanges:=False
    End With
    
    With .ActiveDocument
        Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean
        For Each Tbl In .Tables
            n = Tbl.Rows.Count
        For i = n To 1 Step -1
            fEmpty = True
        For Each cel In Tbl.Rows(i).Cells
            If Len(cel.Range.Text) > 2 Then
                fEmpty = False
            Exit For
        End If
        Next cel
        If fEmpty = True Then Tbl.Rows(i).Delete
            Next i
            Next Tbl
    
        Set cel = Nothing: Set Tbl = Nothing
        
        .SaveAs FileName:=.Path & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        '.SaveAs FileName:=WordPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        '.Close SaveChanges:=False
    End With
    
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing

End Sub
```


----------



## Macropod (Aug 25, 2017)

Try:

```
Sub Excel_to_Word()
Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim StrName As String, r As Long

With ActiveWorkbook
  DataSource = .FullName
  WordPath = .Path & "\FORM-QUOTE (CVBR).docx"
  wsName = .Sheets("Transfer").Name
  StrName = .Sheets("Transfer").Range("J2").Text
End With

With WordApp
  .Visible = True
  .DisplayAlerts = wdAlertsNone
  Set WordDoc = .Documents.Open(WordPath, AddToRecentFiles:=False)
  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 `" & wsName & "$`", SQLStatement1:=""
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    .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:=WordPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    ' and/or:
    '.SaveAs Filename:=WordPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    '.Close SaveChanges:=False
  End With
  .DisplayAlerts = wdAlertsAll
  '.Quit
End With
Set WordDoc = Nothing: Set WordApp = Nothing
End Sub
```


----------



## agent_maxine (Aug 25, 2017)

Thank you for your wonderful assistance. Also noticed that you cleaned up the codes as well and combined 2 Subs... makes more sense.
One quick question - Wondering why the file is saved under My Documents instead of the original SharePoint folder, even though file as saved with:


```
.SaveAs Filename:=WordPath & StrName & ".docx"
```


----------



## agent_maxine (Aug 23, 2017)

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 (Aug 25, 2017)

My bad. Before the first line:

```
.Close SaveChanges:=False
```
insert:

```
WordPath = .Path & "\"
```
That should cause the output document to be saved in the same folder as the mailmerge main document.


----------



## agent_maxine (Aug 28, 2017)

This is what I'm using. For some reason it gives me an error with this portion:

```
.SaveAs FileName:=.Path & "\" & StrName & ".docx"
```

It worked just fine when I didn't have the _*& ""*_ portion... But then it was saving it in My Documents folder haha
I tweaked the code because I don't need the full WordPath for SaveAs, just the initial .Path

Also (and now I'm just being nit-picky), I would like to automatically re-size the row height to 0.25" per one line of text in each box? I was looking at Dynamically Autofit Row Height in VBA however it seemed to be more specific on which column the height is dependent on.


```
Sub Excel_to_Word()

Dim Sheet As Worksheet, wsName As String, DataSource As String, WordPath As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim StrName As String, r As Long

With ActiveWorkbook
    DataSource = .FullName
    WordPath = .Path & "\QUOTE.docx"
    wsName = .Sheets("Transfer").Name
    StrName = .Sheets("Transfer").Range("W2").Text & " - " & .Sheets("Transfer").Range("B2").Text
End With

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    Set WordDoc = .Documents.Open(WordPath, AddToRecentFiles:=False)
    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 `" & wsName & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        .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:=.Path & "\" & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing

End Sub
```


----------



## Macropod (Aug 28, 2017)

agent_maxine said:


> This is what I'm using. For some reason it gives me an error with this portion:
> 
> ```
> .SaveAs FileName:=.Path & "\" & StrName & ".docx"
> ...


But the change you made isn't what I suggested. Had you done as I suggested, your output document would have been saved back to the same folder as the mailmerge main document (i.e. "the initial .Path").



agent_maxine said:


> Also (and now I'm just being nit-picky), I would like to automatically re-size the row height to 0.25" per one line of text in each box? I was looking at Dynamically Autofit Row Height in VBA however it seemed to be more specific on which column the height is dependent on.


I have no idea what textbox you're referring to - this is the first time you've mentioned one. Your link refers to rows heights in Excel, not to textboxes in Excel or Word.


----------



## agent_maxine (Sep 1, 2017)

**Edit:* I edited the codes per your suggestion and it worked perfectly! Shouldn't have doubted haha. Thanks again for all your help!

I am already using WordPath to retrieve the Word template file. Is it ok to re-define it in the same Sub?

As for the row height - yes it was the first time I mentioned it. The Word template has a lot of text boxes and I wanted to make sure the row height will be adjusted to fit all the texts... Wasn't sure if ".AllowAutoFit = False" would restrict the row height as well. But it does adjust to fit the texts so all good there


----------



## Macropod (Sep 1, 2017)

agent_maxine said:


> I am already using WordPath to retrieve the Word template file. Is it ok to re-define it in the same Sub?


Sure you can. Indeed, that's precisely what the 'For Each Tbl In .Tables ... Next' loop does with the Tbl variable; on each iteration is points to a different table. Similarly with the 'For r = .Rows.Count To 1 Step -1 ... Next' loop.


agent_maxine said:


> Wasn't sure if ".AllowAutoFit = False" would restrict the row height as well


AllowAutoFit = False has nothing to do with row heights (only column/table widths), besides which your reference to 'boxes' implied textboxes, not table cells. Couple that with a reference to 'Autofit Row Height. in Excel and everything became very ambiguous.

Word doesn't have an autofit property for _cells_; if you don't specify a _row _height, row heights will expand/contract automatically. Word tables also have an 'At Least' _row _height property, which prevents a row's height decreasing below a set minimum.


----------



## agent_maxine (Sep 5, 2017)

I see. Thank you for the info. It works really great now and I am now including a mail merge of another document in the same sub. I duplicated the middle "With" section for the Document #2  (but omitted the commands to delete the empty rows as I actually need them for Document #2 ). There is an error on the ".SaveAs FileName:=Document2Path ..." line. I imagine there is a cleaner way to automate multiple mail-merge of documents...

*"Automation Error
The Object invoked has disconnected from its clients."*



```
Sub Generate_Document1_Document2()

Dim Sheet As Worksheet, SheetName As String, DataSource As String, Document1Path As String, Document2Path As String
Dim WordApp As New Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Document1Name As String, Document2Name As String, r As Long

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

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    Set WordDoc = .Documents.Open(Document1Path, AddToRecentFiles:=False)
    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
        BindPath = .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:=BindPath & Document1Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    Set WordDoc = .Documents.Open(Document2Path, AddToRecentFiles:=False)
    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
        .SaveAs FileName:=Document2Path & Document2Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing

End Sub
```


----------



## Macropod (Sep 5, 2017)

Try:

```
Sub Generate_Document1_Document2()
Dim WordApp As New Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Sheet As Worksheet, SheetName As String, DataSource As String, r As Long
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

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    
    Set WordDoc = .Documents.Open(Document1Path, AddToRecentFiles:=False)
    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)
    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
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing
End Sub
```


----------



## agent_maxine (Sep 5, 2017)

**Edit to Correct:* Document 1 is being saved twice, under both Document 1 Name and Document 2 Name, and Document 2 is not saved.

Tried the codes  I am no longer getting the Run-time error, however Document 1 is being saved with Document 2's name, and Document 2 remains open with "Letters2".


----------



## Macropod (Sep 5, 2017)

After:
.SaveAs Filename:=Document1Path & Document1Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
insert:
.Close SaveChanges:=False
and, if you want to view that document once the second merge has occurred, before:
.DisplayAlerts = wdAlertsAll
insert:
.Documents.Open Document1Path & Document1Name & ".docx", AddToRecentFiles:=False


----------



## agent_maxine (Feb 26, 2018)

Hi Paul, hope you've been well.

Looking to enhance this MailMerge script here. I would like to close all open Word documents and kill any orphaned Word sessions prior to running any MailMerge.
I inserted the following in the script prior to starting the MailMerge.



> With wordApp
> .ScreenUpdating = False
> Do Until .Documents.Count = 0 'Loop Through Open Word Documents
> .Close SaveChanges:=True 'Close - Save
> ...



It generates "*Compile Error: Method or data member not found*" at the ".Close" command. When I comment out this line, the script runs without closing any of the open Word document... and the ".Quit" command doesn't take any effect (i.e. Word application remains open the whole time).


```
Sub Generate_Document()

Dim WordApp As New Word.Application, WordDoc As Word.Document, Tbl As Word.Table
Dim Sheet As Worksheet, SheetName As String, DataSource As String, r As Long
Dim DocumentPath As String, DocumentName As String

With ActiveWorkbook
    DataSource = .FullName
    DocumentPath = .Path & "\Document.docx"
    SheetName = .Sheets("Transfer").Name
    DocumentName = .Sheets("Transfer").Range("A1").Text & " - Document"
End With

With wordApp
    .ScreenUpdating = False
    Do Until .Documents.Count = 0 'Loop Through Open Word Documents
        .Close SaveChanges:=True 'Close - Save
    Loop
    .Quit SaveChanges:=True 'Quit - Save
End With

Set wordApp = Nothing

With WordApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    
    Set WordDoc = .Documents.Open(DocumentPath, AddToRecentFiles:=False)
    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
        DocumentPath = .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:=DocumentPath & DocumentName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End With
    .DisplayAlerts = wdAlertsAll
End With

Set WordDoc = Nothing: Set WordApp = Nothing

End Sub
```


----------



## agent_maxine (Aug 23, 2017)

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 (Feb 26, 2018)

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 (Feb 27, 2018)

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 (Feb 27, 2018)

agent_maxine said:


> 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 (Feb 28, 2018)

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 (Feb 28, 2018)

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 (Feb 28, 2018)

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 (Feb 28, 2018)

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 (Feb 28, 2018)

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 (Feb 28, 2018)

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 (Mar 1, 2018)

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)


----------



## agent_maxine (Aug 23, 2017)

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 (Mar 1, 2018)

I suspect the issue with 1 & 2 is that Word isn't keeping the document created via the merge as the active document when deleting a previous instance of it. Try:

```
Sub Generate_Document1_Document2()
Dim WdApp As Word.Application, WdDoc As Word.Document, WdTbl As Word.Table
Dim DataSource As String, r As Long, bQuit As Boolean
Dim FilePath As String, Document1Name As String, Document2Name As String
Const StrShtNm As String = "Transfer"

With ActiveWorkbook
    DataSource = .FullName
    FilePath = .Path & "\"
    Document1Name = .Sheets(StrShtNm).Range("U2").Text & " - Document1"
    Document2Name = .Sheets(StrShtNm).Range("U2").Text & " - Document2"
End With

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

With WdApp
    If bQuit = True Then .Visible = False
    .DisplayAlerts = wdAlertsNone
    For Each WdDoc In .Documents
        If WdDoc.FullName = FilePath & Document1Name & ".docx" Then
            WdDoc.Close False: Exit For
        End If
    Next
    For Each WdDoc In .Documents
        If WdDoc.FullName = FilePath & Document2Name & ".docx" Then
            WdDoc.Close False: Exit For
        End If
    Next
    
    Set WdDoc = .Documents.Open(FilePath & "Document1.docx", AddToRecentFiles:=False, ReadOnly:=True)
    With WdDoc
        '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 `" & StrShtNm & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        With WdApp.ActiveDocument
            For Each WdTbl In .Tables
                With WdTbl
                    .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:=FilePath & Document1Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            .Close SaveChanges:=False '*
        End With
        .Close SaveChanges:=False
    End With
    
    Set WdDoc = .Documents.Open(FilePath & "Document2.docx", AddToRecentFiles:=False, ReadOnly:=True)
    With WdDoc
        '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 `" & StrShtNm & "$`", SQLStatement1:=""
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
        With WdApp.ActiveDocument
            .SaveAs Filename:=FilePath & Document2Name & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            .Close SaveChanges:=False '*
        End With
        .Close SaveChanges:=False
    End With
    
    .DisplayAlerts = wdAlertsAll
    If bQuit = True Then .Quit '*
End With

Set WdDoc = Nothing: Set WdApp = Nothing
End Sub
```


----------



## agent_maxine (Mar 2, 2018)

I see that the "_For Each WdDoc In .Documents_" section has been moved up, before the MailMerge starts  It did eliminate the problem of content being replaced by other open file, however it is still not closing the previously merged file... then generated "*Run-time error 5153: Word cannot give a document the same name as an open document.*"

I think I may go with the original Kill-All method haha. I did embed a MsgBox to give options to users if they want to stop the Sub and close all the documents themselves...


----------



## Macropod (Mar 4, 2018)

agent_maxine said:


> I see that the "_For Each WdDoc In .Documents_" section has been moved up, before the MailMerge starts  It did eliminate the problem of content being replaced by other open file


No, that's not what it does; it actually closes any open copies of what is to be the mailmerge output document. What you call the the problem of content being replaced by other open file is avoided by relocating the 'ActiveDocument' code within the 'With WdDoc' mailmerge code block.


agent_maxine said:


> , however it is still not closing the previously merged file... then generated "*Run-time error 5153: Word cannot give a document the same name as an open document.*"


The only way I can see that happening is if _someone else_ has the document open.


----------

