Question

我有一个excel文件，其文件名为word文档。我想使用excel vba打开word文档，然后搜索特定的短语，复制该短语后面的字符，然后将其粘贴回原始的excel文件中。

我尝试了几种实现此设计的方法，但收效甚微。以下是我最近的尝试。

我的主要问题是该程序通常会在遇到我的声明时停止。为什么会发生这种情况，如何修复问题以使代码有效？

谢谢！

Dim objWord As Object
Function insertPrice(cmpNm As Variant)

'obtain company filename from excel cell and convert it to text
Dim compName As String
compName = cmpNm.Text

'open company's proposal
Call openDoc(compName)

End Function

Sub openDoc(compName)
'open the word document
Dim objWord As Object

Set objWord = CreateObject("word.Application")

objWord.Documents.Open ("C:\Users\owner\Documents\" & compName)
objWord.Visible = True

'search within the document for the specific phrase
With ActiveDocument.Select
    .find.ClearFormatting
    With searchRange.find
        .Text = "xxxxx"
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .Execute
    End With
End With

'select the characters following the specific text and copy it
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.MoveRight Unit:=wdCharacter, Count:=9, Extend:=wdExtend
Selection.Copy

'paste the selected data back into the original excel document
ActiveWorkbook.Activate
Range("z262").Select
ActiveCell.PasteSpecial
End sub

Answer 1

您可以使用以下函数：

Function GetData(StrDocNm As String, StrFnd As String)
'Note: A reference to the Word library must be set, via Tools|References
If StrDocNm = "" Then
  GetData = ""
  Exit Function
End If
If Dir(StrDocNm) = "" Then
  GetData = ""
  Exit Function
End If
Dim wdApp As New Word.Application, wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Open(Filename:=StrDocNm, ReadOnly:=True, AddToRecentFiles:=False)
With wdDoc
  'process the documentWith ActiveDocument.Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = StrFnd & "*^13"
      .Replacement.Text = ""
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Execute
    End With
    If .Find.Found Then
      GetData = Trim(Split(Split(.Text, StrFnd)(1), vbCr)(0))
    Else
      GetData = ""
    End If
  End With
    'close
    .Close SaveChanges:=False
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
End Function

您使用以下代码调用

Range("Z262").Value = GetData("C:\Users\" & Environ("UserName") & "\Documents\" & cmpNm.Text & ".doc", "String to Find")

上面的函数将返回在找到它的第一段中跟随StrFnd变量的任何内容。请注意，查找区分大小写。调用代码需要提供完整路径，文件名和放大器。扩展（假设为＆＃34; .doc＆＃34;，但您可能需要将其更改为＆＃34; .docx＆＃34;，例如）。

使用Excel VBA从Word文档复制数据

1 个答案: