Как OpenDataSource для Word MailMerge из листа Excel

Question

Я пытаюсь автоматизировать создание текстового документа, используя OpenDataSource из MailMerge и используя в качестве источника рабочий лист, на котором ранее были сохранены данные.

Проблема в том, что каждый раз wdocSource.MailMerge.OpenDataSource называется паузой в Excel при выполнении. Процесс WINWORD.EXE запущен, но Excel не продолжает работу, поскольку он ждал, что что-то произойдет, и мне нужно убить процесс, чтобы он ответил.

Я проверил эти вопросы, но не могу заставить его работать:

Mailmerge из Excel с использованием шаблона Word VBA

Выполнение слияния почты Word

Запуск слияния почты MS Word из excel

Const sTempSourceSheet = "TempSourceSheet"

Создание источника рабочего листа

Sub PrintArray(Data, SheetName, StartRow)
    Dim Destination As range
    Set Destination = range("A" & StartRow)
    Set Destination = Destination.Resize(1, UBound(Data))
    Destination.FormulaR1C1 = Data
End Sub

''''''''''''''''''''''''''''''''''''''''
' SaveSourceSheet
Public Sub SaveSourceSheet(cols() As String, arr() As String)
On Error GoTo error
    Dim ws As Worksheet

    With ActiveWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = sTempSourceSheet
    End With

    PrintArray cols, sTempSourceSheet, 1
    PrintArray arr, sTempSourceSheet, 2

done:
    Exit Sub

error:
    With ActiveWorkbook
        .Sheets(sTempSourceSheet).Delete
    End With

    Resume done
End Sub

И код для запуска MailMerge

Sub Contract(wordfile As String)
    Dim wd As Object
    Dim wdocSource As Object
    Dim excelfile As String
    Dim strWorkbookName As String
    excelfile = ThisWorkbook.path & "\" & ThisWorkbook.Name
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open(wordfile)

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource Name:= _
    excelfile, ConfirmConversions:=False, _
    ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
    PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
    WritePasswordTemplate:="", Revert:=False, format:=wdOpenFormatAuto, _
    Connection:= _
    "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
    "User ID=Admin;" & _
    "Data Source=" & excelfile & ";" & _
    "Mode=Read;Extended Properties=" & _
    "HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
    , SQLStatement:="SELECT * FROM `TempSourceSheet$`", SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
    End With

    wd.visible = True
    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing
End Sub

Есть идеи?

обновление

После изменений, предложенных @macropod, у меня остались проблемы:

В строке .OpenDataSource слово показывает это сообщение:

Любой из вариантов вызывает ошибку:

Я проверил, есть ли файл Excel и содержит лист с правильным именем.

Answer 1

« Проблема в том, что каждый раз, когда вызывается wdocSource.MailMerge.OpenDataSource, excel приостанавливает выполнение. Процесс WINWORD.EXE запущен, но Excel не продолжает работу, поскольку он ждал, что что-то произойдет, и мне нужно убить процесс, чтобы он ответил. »

Это означает, что документ вы ' повторная попытка открытия, вероятно, уже является основным документом mailmerge, и код ждет, когда вы ответите на запрос SQL, который Word создает при открытии таких документов.

В качестве альтернативы, если документ содержит автоматические макросы, он может ждать ответа пользователя.

Ваш код также содержит:

ReadOnly:=False, LinkToSource:=True

, который должен быть:

ReadOnly:=True, LinkToSource:=False

Я бы также предложил сменить провайдера на :

Microsoft.ACE.OLEDB.12.0

Попробуйте следующий код:

Sub Contract(wordfile As String)
Dim wdApp As Object, wdDoc As Object
Dim StrMMSrc As String: StrMMSrc = ActiveWorkbook.FullName
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 0
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:="SELECT * FROM `TempSourceSheet$`", SubType:=wdMergeSubTypeAccess
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    .Close SaveChanges:=False
  End With
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub