Scraping Word with Excel VBA

Question

I have a Word document full of newspaper articles. Each newspaper article is preceded by the article title and the string "Length:", which is followed by the number of words in the article (i.e. "Length: 1500 words"). I simply need an Excel Macro that will comb the Word document and extract the length value for each article - placing these values in an Excel column.

Through my Googling, I found this: Extract Data from Word Document to an Excel SpreadSheet

This is almost what I need, but it only returns the first article length value found by the search. How do I modify the code to find every article length value, return these values to an Excel column and then terminate?

So your problem now is looping through files and writing to an Excel sheet? Please try a few ideas and ask specific questions to problems you're having with code. Right now your question is really general and mostly just asking people to write your code for you... — SpaceSteak, Jan 27 '16 at 13:06

score 0 · Answer 1 · answered Jan 27 '16 at 16:49

The code to which you link is not particularly robust. I've extracted the assignment to the cell in Excel (ExR(1, 1) = WDR ' place at Excel cursor) and built more robust Word code around it.

The code uses the Word Range object instead of Selection. This is more efficient, more predictable and the screen won't jump around. The Find uses a wildcard search for the specific text, plus the digits between "Length " and " words". Since a successful Find includes the found Range, all that's necessary is to assign the Range's Text to the cell in Excel.

The Find plus assignment is built into a LOOP, which runs as long as Find.Execute is successful. For the cell assignment in Excel a COUNTER is incremented in each loop so you don't need to hard-code the target cell indices.

Dim strFind As String
Dim rngFind As word.Range 'or As Object if you don't set a Reference to the Word object library
Dim bFound As Boolean
Dim iCellCounter As Long

strFind = "Length: [0-9]{1;} words"
bFound = False
iCellCounter = 1
Set rngFind = WApp.ActiveDocument.Content
With rngFind.Find
    .ClearAllFuzzyOptions
    .ClearFormatting
    .ClearHitHighlight
    .Format = False
    .MatchWildcards = True
    .Text = strFind
    .wrap = wdFindStop   '0 if you don't use a Reference to the Word object library
    Do
        bFound = .Execute
        If bFound Then
            ExR(1, iCellCounter) = rngFind.Text
            iCellCounter = iCellCounter + 1
        End If
    Loop While bFound
End With

Scraping Word with Excel VBA

1 Answers1