Word VBA - 运行doc并使用Excel工作表替换文本

时间:2012-08-15 14:47:50

标签: vba ms-word word-vba

我正在尝试创建一个执行以下操作的宏:

浏览文档并查找##格式的字符串。我正在寻找的项目是数字,因此它们将始终是## 014,## 054等。如果找到包含## ...的字符串,则需要在我的文档中搜索excel工作表CodesNew.xls。如果它在A列中找到匹配的字符串,则需要将Word文档中的字符串替换为B列中的值。现在是棘手的部分!该值需要作为合并域输入。

我现在所拥有的只是搜索Word文档并替换它。

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "##*"
   .Replacement.Text = "KDKKD"
   .Forward = True
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = True
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

1 个答案:

答案 0 :(得分:1)

你可以试试这个。您需要通过工具 - >参考,在WOrd VBA编辑器中引用Microsoft ActiveX数据对象库,修复任何路径,文档和工作表名称,并添加自己的错误检查。如果您实际使用.xlsx来存储代码,则需要更改OLE DB提供程序名称

Sub replaceWithNamesFromExcel()
' Alter this as needed
Const strMatch As String = "##[0-9]{1,}"
Dim bOpened As Boolean
Dim connXL As ADODB.Connection
Dim rsXL As ADODB.Recordset
Dim rng1 As Word.Range
Dim rng2 As Word.Range
Set connXL = New ADODB.Connection
With connXL
  ' Fix the path in here to be the one you need
  .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mypath\test.xls;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"""
  .Open
End With
Set rsXL = New ADODB.Recordset
Set rsXL.ActiveConnection = connXL
Set rng1 = ActiveDocument.Content
With rng1.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = strMatch
  .Forward = True
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = True
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  While .Execute
    Set rng2 = rng1.Duplicate
    rsXL.Open "SELECT F2 FROM [CodeNew$] WHERE F1 = '" & rng2.Text & "'"
    If Not rsXL.EOF Then
      rng2.Fields.Add Range:=rng2, _
        Type:=WdFieldType.wdFieldEmpty, _
        Text:="MERGEFIELD """ & rsXL.Fields(0).Value & """", _
        preserveformatting:=False
    End If
    rsXL.Close
    Set rng2 = Nothing
  Wend
End With
Set rng1 = Nothing
Set rsXL = Nothing
connXL.Close
Set connXL = Nothing
End Sub

试图整合评论......

我认为OP在评论中描述的问题可能是因为.xls文件直接放在c:\下,这可能导致权限问题,和/或不更改.Connectionstring行以反映实际位置.xls文件。但很难说清楚。