Automating word through excel

All,

I am trying to piece through a word document line by line, and write that info to a excel worksheet. I found some code to piece through a word doc however I am having some issue altering the code as I am unfamiliar with Word VBA.

See below for code:

I am sending a path to this sub to open the word doc. I have the oDoc dim outside the routine for use in other routines.

Code:

---

Sub OpenWordDoc(strPath As String)

'Open an existing Word Document from Excel
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
' Should open as the forefront
objWord.Activate
'Change the directory path and file name to the location
'of the document you want to open from Excel
Set oDoc = objWord.Documents.Open(strPath)

Call LoopingText


objWord.Quit
End Sub

---

I am then using the following code to loop through the word document and add each line to a string 'outputStr'. This sub is causing me issue. This sub was originally the routine written for Word.

Code:

---

Sub LoopingText() ''()
'Will move to the end of each line in the document and move the text to match
 'Declare variables
Dim outputStr As String
 Dim currLine As String
 Dim endChar As String
 Dim numOfLines As Integer
 'Count the number of non blank lines in current document
numOfLines = oDoc.BuiltinDocumentProperties("NUMBER OF LINES")
oDoc.Activate

 'Move to start of document
Selection.HomeKey Unit:=wdStory
 'Start the loop - looping once for each line
For x1 = 1 To numOfLines
          'Move to start of line
        Selection.HomeKey Unit:=wdLine
                    'Select entire line and copy into variable currLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        currLine = Selection.Range.Text
                'Remove final character (line break) from currLine
        currLine = Left(currLine, (Len(currLine) - 1))
       
        outputStr = outputStr & currLine

        'Move down one line
    Selection.MoveDown Unit:=wdLine, Count:=1
    'Move to the next part of the loop
Next x1
End Sub

---

The line Selection.HomeKey Unit:=wdStory is causing an error:

Run-time '438' Object does not support this property or method.

I have tried:

oDoc.Selection.HomeKey Unit:=wdStory

oDoc.HomeKey Unit:=wdStory

Any help would be really appreciated. Thanks

Try:

Code:

---

Sub OpenWordDoc(StrDocNm As String)
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document, StrTxt As String
If Dir(StrDocNm) = "" Then Exit Sub
Set wdDoc = wdApp.Documents.Open(Filename:=StrDocNm, ReadOnly:=False, AddToRecentFiles:=False)
With wdDoc
    'process the document
    StrTxt = Replace(Replace(Replace(.Range.Text, Chr(11), "¶"), Chr(12), "¶"), vbCr, "¶")
    'close
    .Close SaveChanges:=False
End With

wdApp.Quit

Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

---

Simply replace the ¶ characters with whatever you want in place of the paragraph breaks, line breaks, & section breaks.

Quote:

---

Originally Posted by atr140

The line Selection.HomeKey Unit:=wdStory is causing an error:
Run-time '438' Object does not support this property or method.

---

Withoiut looking to then merits of the code, but simply to address the error message - when using LateBinding to the Word object as in your code, you cannot use Word specific values such as wdStory. You must use instead the numeric equivalents of such commands. The enumeration value for wdStory is 6.

Paul's code example uses early binding to the Word object and so may be used with such values. There are advantages and disadvantages to both approaches. Programming is easier with early binding. Late binding makes the code more transportable - especially between different Office versions.

FWIW Paul's code could also be used with late binding

Code:

---

Sub OpenWordDoc(StrDocNm As String)
'Note: Late binding no reference to the Word library required
Dim wdApp As Object, wdDoc As Object, StrTxt As String, bStart As Boolean
    If Dir(StrDocNm) = "" Then Exit Sub
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
        Set wdApp = CreateObject("Word.Application")
        bStart = True
    End If
    On Error GoTo 0
    Set wdDoc = wdApp.Documents.Open(FileName:=StrDocNm, ReadOnly:=False, AddToRecentFiles:=False)
    With wdDoc
        'process the document
        StrTxt = Replace(Replace(Replace(.Range.Text, Chr(11), "¶"), Chr(12), "¶"), vbCr, "¶")
        'close
        .Close SaveChanges:=False
    End With
    If bStart Then wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

---

Paul & Graham,

Thank you both for the solutions. They work a treat. Thank you for the more detailed response Graham; I will be sure to keep that in mind.

Aaron