[RESOLVED] Extract information from a word doc using excel vba

[scootgp200]

Hi, I want to automate a web site where word documents can be completed following a set format and an excel spreadsheet would read the document/s and build web pages basedon the word doc formating but need a pointer in the right direction when it comes to interogating the word file.I have code to read the doc and copy the story.

Dim Word As New Word.Application
Dim WordDoc As New Word.Document
Dim Doc As String
Dim wb1 As Workbook
Dim Fname2 As String
Doc = "E:\work spreadsheets\test1.doc"
Set WordDoc = Word.Documents.Open(Doc)
Word.Selection.WholeStory
Word.Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
WordDoc.Close
Word.Quit

However what I want to do is read the doc line by line so I can for example pick up the heading 1 and work with that then the heading 2, paragraphs etc and build the web page. I would then hold the heading types in variables to use in building the site navigation.Can anyone give me some excel vba code that would get me started.

Thanks

[westconn1]

hard to work with word documents by line as lines, as lines change by wordwrap, much easier to work by paragraphs
for each para in worddoc.paragraphs

[scootgp200]

Yes selecting each paragraph makes sense and is what I am looking for and where I am stuck.

The bit of code works in that from Excel it will open a word doc copy the whole story and paste it into word. So rather than selecting the whole story what would the code be to select each paragraph and test to see what formating it contained such as heading 1, 2, 3 or a plain paragraph.

You are correct, I will need to build on some error trapping as for example a document must contain one heading 1 only.

Thanks
Bryan

[scootgp200]

I have done some more work on this with some success and can now access a word doc and extract the data. But when the code ends it gives an error '91 object variable or with block variable not set' and 'error 462 the remote server machine does not exist or is unavailable'
I can't see for looking what is causing this so can anyone help.

Thanks
Bryan

Here is the code:

Sub Main()
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim myDocName As String
Dim rowcount As Integer
Dim iParagraph As Word.Paragraph
Dim iCounter As Long

On Error GoTo ErrHandler

Set oWord = New Word.Application

rowcount = 1

Do While Excel.Sheets("Sheet2").Range("A" & rowcount) <> ""

myDocName = Excel.Sheets("Sheet2").Range("A" & rowcount).Value
MsgBox myDocName

Set oWdoc = Word.Documents.Open(myDocName)

Word.Selection.WholeStory
For Each iParagraph In Word.Selection.Paragraphs

If iParagraph.Style = ActiveDocument.Styles("Heading 1") Then
' MsgBox "heading 1"
' Write heading as html
Excel.Sheets("Sheet3").Range("a1000").End(xlUp).Offset(1, 0).Value = "<H1>" & iParagraph.Range.Text & "</H1>"
End If
If iParagraph.Style = ActiveDocument.Styles("Heading 2") Then
' MsgBox "heading 2"
End If
If iParagraph.Style = ActiveDocument.Styles("Heading 3") Then
' MsgBox "heading 3"
End If
If iParagraph.Style = ActiveDocument.Styles("Normal") Then
' MsgBox "normal"
End If

iCounter = iCounter + 1
Excel.Sheets("Sheet1").Select
Range("A" & iCounter).Value = iParagraph.Range.Text
Next iParagraph


Cleanup:
oWdoc.Close
Set oWdoc = Nothing
oWord.Quit
Set oWord = Nothing

rowcount = rowcount + 1

Loop

Exit Sub 'Exit the sub or the Error Handler is invoked

ErrHandler:
Select Case Err
'Err is already defined in Excel
'to hold the numeric code for errors
'but as an error occurs add text to explain solution.
Case 91
MsgBox "There is no active cell"
Case 1005
MsgBox "The worksheet is protected."
Case Else
MsgBox Error(Err) & Err.Number '& Err.Description
End Select

End Sub

[westconn1]

use code or highlight tags when you post code

which lines is where the errors occur?

where you use word.....

Word.Selection.WholeStory
For Each iParagraph In Word.Selection.Paragraphs

you should be using your word object oword
activedocument should be avoided, use the document object owdoc

[scootgp200]

Thanks,

I've made some changes and removed the

Word.Selection.WholeStory

and changed the For Each to a Select Case and it all works but only if Outlook is open! If I close Outlook then try running the code I get the error

462 The remote server does not exist or is unavailable

If I open the spreadsheet and run without opening Outlook I get the error

429 ActiveX component can't create object

Why would Outlook affect the macro

Here is the code

Sub Main()
    Dim oWord As Word.Application
    Dim oWdoc As Word.Document
    Dim myDocName As String
    Dim rowcount As Integer
    Dim iParagraph As Word.Paragraph
    Dim iCounter As Long
    
    On Error GoTo ErrHandler
    
    Set oWord = Word.Application
    
rowcount = 1

Do While Sheets("Sheet2").Range("A" & rowcount) <> ""

myDocName = Sheets("Sheet2").Range("A" & rowcount).Value

Set oWdoc = oWord.Documents.Open(myDocName)

    For Each iParagraph In oWdoc.Paragraphs()
    
       Select Case iParagraph.Style
       Case "Heading 1"
       ' heading 1 stuff
           Sheets("Sheet3").Range("a1000").End(xlUp).Offset(1, 0).Value = "<H1>" & iParagraph.Range.Text & "</H1>"
       Case "Heading 2"
       ' heading 2 stuff
       Case "Heading 3"
       ' heading 3 stuff
       Case "Normal"
       ' Normal stuff
       Case Else
       ' if it is something else?
       End Select

    iCounter = iCounter + 1
    Sheets("Sheet1").Select
    Range("A" & iCounter).Value = iParagraph.Range.Text
    Next iParagraph

Cleanup:
    oWdoc.Close
    Set oWdoc = Nothing

rowcount = rowcount + 1

Loop
    
    oWord.Quit
    Set oWord = Nothing

Exit Sub        'Exit the sub or the Error Handler is invoked.
    
ErrHandler:
        Select Case Err
'Err is already defined in Excel to hold the numeric code for errors
            Case 1000
                MsgBox "Cannot assign a value to the selection."
            Case 1004
                MsgBox Err & " " & Error(Err) & Chr(13) & Chr(13) _
        & "The method you specified cannot be used on the object."
            Case 1005
                MsgBox "The worksheet is protected."
            Case Else
                MsgBox Error(Err) & Err.Number  '& Err.Description
        End Select
    
End Sub

[westconn1]

i do not understand what outlook has to do with this code at all

on which line do you get the activex error?

[scootgp200]

I've been told the reason and it is because word is set as default editor for Outlook.

By using this line of code

Set oWord = CreateObject("Word.Application")

The problem seems to be resolved.

[westconn1]

ok, otherwise you could add a reference to word in your excel vba