Mail Merge Word Source in relative path

Question

I'm newbie in VBA (few days) so give me some chance ;-)

What I have:
3 files in one folder.

ST.xlsm - with macros;
vessel.xlsx - with data for mail merge;
Cert QQ.docx - with mail merge fields already linked with vessel.xlsx;

The path to this files is relative (sharepoint) and changes for each new vessel arrived.

What I'm trying to do:

I want to run macro in ST.xlsm, which will open Cert QQ.docx and perform mail merge from vessel.xlsx from merge$ worksheet

What is the problem:

All going well until the command OpenDataSource. After that command VBA declare that Word couldn't open Data Source, from the other side Word declare - Database engine error, and offer to choose DataSource manually, showing the path to vessel.xlsx

But, when I put files outside of sharepoint with absolute path, code is working like a charm. But this is not acceptable.

One of possible solution is to convert relative path to absolute, but my knowledge in this is poor. Would be appreciate for any suggestions. Code is below, but, may be it's not smooth as compiled from different sources.

I use Office 365 with corporate subscription

Sub MailMerge()
    Dim StrMMSrc As String
    Dim StrMMPath As String
    Dim objWrdApp As Object, objWrdDoc As Object
    Dim folder As String
    Dim filename As String
    
    Set objWrdApp = CreateObject("Word.Application")
    
    folder = ThisWorkbook.Path
    
    Debug.Print (folder)
    
    Const wdExportFormatPDF = 17
    Const wdExportOptimizeForPrint = 0
    Const wdExportAllDocument = 0
    Const wdExportDocumentContent = 0
    Const wdExportCreateNoBookmarks = 0
    Const wdDialogMailMergeOpenDataSource = 81
    Const wdFormLetters = 0
    Const wdMergeInfoFromExcelDDE = 2
    Const wdAlertsAll = -1
    Const wdAlertsNone = 0
    Const wdSendToNewDocument = 0
    
    objWrdApp.Visible = True
    
    'absolute path - D:\Work\P.S.O. Beheer BV\Albers Hansen Baltics - vessels\Tankers\Turchese\2021.03.30
    'Disable alerts to prevent an SQL prompt
    objWrdApp.DisplayAlerts = wdAlertsNone
    Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Cert QQ.docx", ConfirmConversions:=False, ReadOnly:=False, AddToRecentfiles:=True)
    
    With objWrdDoc.MailMerge
       .MainDocumentType = wdFormLetters
       'Define the output
       .Destination = wdSendToNewDocument
       .SuppressBlankLines = True
       'Connect to the data source
       .OpenDataSource Name:=folder & "/" & "vessel.xlsx", _
            LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
            "Data Source=https://pcugroup.sharepoint.com/sites/AlbersHansenBaltics/Shared Documents/vessels/Tankers/Turchese/2021.03.30/vessel.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
            SQLStatement:="SELECT * FROM `Merge$`"
    End With 
End Sub

Mail Merge Word Source in relative path

0 Answers0