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]

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]

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]

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]

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]

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]

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]

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]

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]

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"