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]

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]

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]

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.

, 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.