使用vba自动套用信函时出错

Question

这里是编码的新手，我的目标是创建一个电子表格，它将信息输入到套用信函中，创建一个新文件夹，然后将其保存到新文件夹中，然后重复。下面的代码将完成一个迭代，但是在第二个循环中遇到错误“远程过程调用失败”，我认为在第二次运行时重新打开模板存在问题。

Public Sub WordFindAndReplace()
    Dim ws As Worksheet, msWord As Object, itm As Range, fileName As String, Path As String


    Set ws = ActiveSheet
    Set msWord = CreateObject("Word.Application")

    Set objdoc = msWord.Documents.Add



    For i = 1 To 4

    fileName = Cells(i, 4).Value
     Path = "C:\Users\jarafat\Desktop\Variation1\" & fileName & "\" & fileName & ".docx"

If Len(Dir("C:\Users\jarafat\Desktop\Variation1\" & fileName, vbDirectory)) = 0 Then
  MkDir "C:\Users\jarafat\Desktop\Variation1\" & fileName
  End If

    With msWord
        .Visible = True
        .Documents.Open "C:\Users\jarafat\Desktop\Variation1\VariationTemplate1.docx"
        .Activate



        With .Activedocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "#address"
            .Replacement.Text = ws.Cells(i, 1).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With

        With .Activedocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "#address1"
            .Replacement.Text = ws.Cells(i, 2).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With

        With .Activedocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "#Description"
            .Replacement.Text = ws.Cells(i, 3).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With

        With msWord.Activedocument

        .SaveAs Path
        End With

        .Quit SaveChanges:=True
   End With
Next i
End Sub

Answer 1

之所以出现此问题，是因为Word应用程序已在循环中退出。因此，第二个（及以下）循环不再可用：

    .Quit SaveChanges:=True
  End With
Next i

您需要这样做，并且养成正确地将releasing对象（设置为Nothing）设置为外部应用程序的习惯也是一个好主意。

  End With
Next i
msWord.Quit SaveChanges:=True
Set msWord = Nothing

我也建议您声明并使用Document对象，而不要依赖ActiveDocument。始终有可能活动文档不是您期望的文档。例如：

'At the beginning of the code
Dim doc as Object
'More code...
Set doc = .Documents.Open "C:\Users\jarafat\Desktop\Variation1\VariationTemplate1.docx"
'No need to activate, now...
'Activate
With doc.Content.Find
  'And so on until...
  .SaveAs Path
  'You're done with the document, so release the object
  Set doc = Nothing
End With

Answer 2

除了辛迪的解决方案...

而不是多次重复并略有不同：

  With .Activedocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting

        .Text = "#address"
        .Replacement.Text = ws.Cells(i, 1).Value

        .Forward = True
        .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
    End With

您可以制作一个单独的子：

Sub ReplaceText(doc As Object, findWhat, replaceWith)
      With doc.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = findWhat
            .Replacement.Text = replaceWith

            .Forward = True
            .Wrap = 1         'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2  'wdReplaceAll (WdReplace Enumeration)
      End With
End sub

...并从循环中调用它

Dim doc
With msWord
    .Visible = True
    Set doc = .Documents.Open("C:\Users\jarafat\Desktop\Variation1\VariationTemplate1.docx")

    ReplaceText doc, "#address", ws.Cells(i, 1).Value
    ReplaceText doc, "#address1", ws.Cells(i, 2).Value
    ReplaceText doc, "#Description", ws.Cells(i, 3).Value
    'etc