Невозможно изменить настраиваемое поле в слове через Excel 2016 VBA

Question

Я довольно долго пытался заставить это работать.У меня есть книга Excel, которая содержит информацию для клиентов.Я хочу нажать на кнопку, которая запускает макрос, который принимает текстовый документ - шаблон, - и обновить поля в шаблоне в соответствии с данными, хранящимися в книге Excel (т. Е. Мне нужно поле настраиваемого свойства «клиент» вшаблон, чтобы изменить его значение на «Джон Смит»).

Я могу открыть документ Word отлично, и у меня был некоторый успех в обновлении полей из слова VBA, но я не смог получить Excel VBA для обновления полей документа Word.Я получаю ошибку 4248, ~ "нет открытого документа" , которая возникает в цикле for.Если я помещаю цикл for в OpenWordDoc, я все равно получаю ошибку 4248 .Любая помощь приветствуется.

Вот код, с которым я работал:

Sub GenDraftLetter()
Dim i As Long
Dim j As Double
Dim k As Object
Dim filenam As String
Dim prop As DocumentProperty
Dim oppname As String
Dim clientname As String
Dim objWord As Object
Dim ow As Window
Dim wd As Object
Dim fwd As Object

Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
    Set objWord = CreateObject("Word.Application")
End If
i = InputBox("Number of row for the Client", "Row for Client")
j = 1
Do Until Mid(Cells(i, 1), j, 1) = ","
    j = j + 1
Loop
clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
filenam = "template.docx"
OpenWordDoc (filenam)
For Each prop In ActiveDocument.CustomDocumentProperties
    If LCase(prop.Name) = "client" Then
        prop.Value = clientname
        Exit For
    End If
Next
End Sub



Private Sub OpenWordDoc(filenam)
Dim fullname As String
Dim driv As String
Dim filepat As String


    Set wordapp = CreateObject("word.Application")

    wordapp.Documents.Open filepat Thisworkbook.Path & "\" & filenam
    wordapp.Visible = True
    wordapp.Activate

Answer 1

Код в вопросе имеет ряд проблем.Я начну с «простого», хотя и не первого.

Excel VBA не «знает» ActiveDocument

строка должна вызывать ошибку компиляции в Excel VBA, хотя она будет нормально работать в Word VBA:

For Each prop In ActiveDocument.CustomDocumentProperties

В Excel VBA нет объекта ActiveDocument, это есть только в Word VBA.Если код работает в любой среде, кроме Word VBA, это не будет работать.В среде VBA необходимо указать, в какой библиотеке он может найти этот объект;библиотека Word должна быть указана с использованием объекта Application для Word:

For Each prop In objWord.ActiveDocument.CustomDocumentProperties    

Не использовать ActiveDocument, если это вообще возможно

Пока ActiveDocument работает, это не так надежно, как работа напрямую с объектом.Поскольку этот код открывает документ, его можно присвоить переменной объекта при его открытии, а затем работать с переменной объекта.

Поскольку в указанном коде используется отдельная процедура для открытия документа, ее можно изменить с Sub на Function, чтобы вернуть объект документа.

Документы нужно искать в одном и том же экземпляре Word

Кроме того, объект Word.Application должен быть передан процедуре "open".Код в вопросе запускает экземпляр приложения Word в первой процедуре и в процедуре open.Это отдельные экземпляры, поэтому документ, открытый в процедуре «open», не будет виден первой процедуре.Вот причина сообщенной ошибки.

Код можно изменить на это (некоторые «Dims» удалены для ясности):

Sub GenDraftLetter()
  Dim i As Long
  Dim j As Double
  Dim filenam As String
  Dim prop As Variant
  Dim clientname As String
  Dim objWord As Object
  Dim objDoc as Object

  Set objWord = GetObject(, "Word.Application")
  If objWord Is Nothing Then
    Set objWord = CreateObject("Word.Application")
  End If
  i = InputBox("Number of row for the Client", "Row for Client")
  j = 1
  Do Until Mid(Cells(i, 1), j, 1) = ","
    j = j + 1
  Loop
  clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
  filenam = "template.docx"
  Set objDoc = OpenWordDoc(filenam, objWord)
  For Each prop In objDoc.CustomDocumentProperties
    If LCase(prop.Name) = "client" Then
        prop.Value = clientname
        Exit For
    End If
  Next
End Sub

Private Function OpenWordDoc(filenam, objWord) as Object
    Dim objDoc as Object

    'In case the code is called where no Word object is open
    'Can be removed if this is not the intention of this procedure
    If objWord Is Nothing Then
       Set objWord = GetObject(, "Word.Application")
       If objWord Is NOthing Then
          Set objWord = CreateObject("Word.Application")
       End If
    End If

    Set objDoc = objWord.Documents.Open(Thisworkbook.Path & "\" & filenam)
    Set OpenWordDoc = objDoc
End Function