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

agent_maxine

New Member
Joined
Aug 23, 2017
Messages
38
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/general-excel-discussion-other-questions/975319-excel-vba-run-mail-merge-word.html
 

agent_maxine

New Member
Joined
Aug 23, 2017
Messages
38
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!

Code:
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

New Member
Joined
Aug 23, 2017
Messages
38
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

Retired Moderator
Joined
Aug 27, 2007
Messages
3,321
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:
Code:
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

New Member
Joined
Aug 23, 2017
Messages
38
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?

Code:
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

Retired Moderator
Joined
Aug 27, 2007
Messages
3,321
I'd be inclined to use something like:
Code:
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
 
Last edited:

agent_maxine

New Member
Joined
Aug 23, 2017
Messages
38
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?

Code:
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

Retired Moderator
Joined
Aug 27, 2007
Messages
3,321
Try:
Code:
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

New Member
Joined
Aug 23, 2017
Messages
38
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:

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

Forum statistics

Threads
1,085,651
Messages
5,384,936
Members
401,927
Latest member
commae

Some videos you may like

This Week's Hot Topics

Top