Copying Data From Word Document Using Excel VBA

问题

I have an excel file that that has a filename of a word document. I want to use excel vba to open the word document, then search for a specific phrase, copy the characters following that phrase, and paste it back into the original excel file.

I have attempted several ways to implement this design, with little success. Below is my most recent attempt.

My main issue is that the program usually just stops when it hits my with statement. Why does that happen, and how do I fix things so that the code works?

Thank you!

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

回答1:

You could use a Function like:

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

which you'd call with code like:

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

The above function will return whatever follows your StrFnd variable in the first paragraph in which it is found. Note that the Find is case-sensitive. The calling code needs to supply the full path, filename & extension (assumed to be ".doc", but you may need to change it to ".docx", for example).

来源：https://stackoverflow.com/questions/48747596/copying-data-from-word-document-using-excel-vba

标签

excel

vba

ms-word

find