I have managed to cobble together this much from various searches.
Most of this from https://stackoverflow.com/questions/...xcel-worksheet
However I am not using a DB, just want to use an Excel worksheet.
Option Explicit
Sub Contract(Wordfile As String, strSheetName As String)
Dim wdApp As Object, wdDoc As Object
Dim StrMMSrc As String, strSQL As String
StrMMSrc = "F:\Temp\Address Trial,xlsm" 'ActiveWorkbook.FullName
Wordfile = "F:\Users\Paul\Documents\Address Details 7165 MM.docm"
strSheetName = "Sheet1"
strSQL = "SELECT * FROM " & strSheetName & ""
If Dir(Wordfile) = "" Then
MsgBox "Cannot find:" & vbCr & Wordfile, vbExclamation
Exit Sub
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo Err_Handler
With wdApp
.Visible = True
.WordBasic.DisableAutoMacros
.DisplayAlerts = 0 ' wdAlertsNone
Set wdDoc = .Documents.Open(Wordfile)
With wdDoc
With .MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:=strSQL, SubType:=wdMergeSubTypeAccess
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
.Close SaveChanges:=False
End With
End With
Err_Handler:
Debug.Print Err.Number & " - " & Err.Description
MsgBox Err.Number & " - " & Err.Description
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
but get the attached screen when trying to set the source?