asked on

Write data from on word document to another using VB.NET

I have an ongoing project creating a small application that reads one MS Word document for values contained in parentheses/brackets and write the data into another MS Word document in a list format.

I have the data capture down pat; exporting it to a message box with the number of the page it resides. However, I am quite new at VB.Net and working with two instances of MS Word in a Do Loop is becoming a bit overwhealming.

I would appreciate it if someone could guide me in the right direction for writing the data I am capturing into another word document.

Cheers
G_M

Public Sub ProcessDocumentToWord()
        Dim objWord As Word.Application
        Dim objDoc As Word.Document
        Dim strWord As String
        Dim objSelection As Word.Selection
        Dim strInputFile As String
        Dim objPageNumber As String
        Dim objNewDoc As Word.Document
        Dim misValue As Object = System.Reflection.Missing.Value

        strInputFile = frmGetReferences.lblInputFile.Text
        objWord = CreateObject("Word.Application")
        objNewDoc = objWord.Documents.Add(misValue)
        objNewDoc.SaveAs(frmGetReferences.lblOutputFolder.Text & "" & frmGetReferences.txtOutputFilename.Text & ".doc")
        objDoc = objWord.Documents.Open(strInputFile)
        objSelection = objWord.Selection
        objSelection.Find.Forward = True
        objSelection.Find.MatchWildcards = True
        objSelection.Find.Text = "\(*\)"

        MessageBox.Show("You have selected DOC")

        Do While True

            objSelection.Find.Execute()
            If objSelection.Find.Found Then
                strWord = objSelection.Text
                objPageNumber = objSelection.Range.Information(Word.WdInformation.wdActiveEndPageNumber)
                MessageBox.Show(strWord & " , Page" & objPageNumber)
                objNewDoc.Selection.TypeText(strWord & " , Page" & objPageNumber)
            Else
                Exit Do
            End If
        Loop

        objDoc.Close()
        objNewDoc.Close()
        objWord.Quit()

        objDoc = Nothing
        objWord = Nothing
        objNewDoc = Nothing

    End Sub

Open in new window

Norie

Are you sure you have 2 instances of Word?

You seem to have 2 documents referenced by objNewDoc and objDoc in the same instance.

Anyway, what part are you having problems with?

Is it the loop itself or something to do with putting the data into the new document?

G_M

ASKER

The data I am capturing is being exported from objDoc to a message box, one after the other... I want that data written to the Word document in objNewDoc.

So I guess it is just writing the data to the new file that is the problem (as far as I can tell).

Cheers
G_M

G_M

ASKER

This line is incorrect:
objNewDoc.Selection.TypeText(strWord & " , Page" & objPageNumber)

Norie

How do you want the data in the new table?

Have you considered using a table with 2 columns, one for the text and one for the page it was found on?

G_M

ASKER

the data just needs to be in a list format i.e.

(item 1), Page 1
(Item 2), Page 1
(Item 3), Page 2
...etc

GrahamSkan

If you are going to work with to documents, I strongly advise the use of Range objects instead of the Selection object. Then you won't have to keep track of which document is active, and where the Selection is.

Norie

Well that can be done, it's just that it sometimes easier to use tables.

In my experience anyway.:)

Anyway, I'll see what I can come up.

In the meantime here's an example of how you could use a loop to put values in a list.

Dim rng As Range
Dim I As Long
Dim lngLen As Long
Dim arrItems

    arrItems = Split("Item1, Item2, Item3, Item4, Item5", ",")


    Set rng = ThisDocument.Range(0, 0)
    For I = LBound(arrItems) To UBound(arrItems)

        rng.InsertAfter arrItems(I)

        rng.InsertParagraphAfter
        rng.InsertParagraphAfter

        lngLen = Len(rng) + lngLen

        Set rng = ThisDocument.Range(lngLen, lngLen)
  Next I

Open in new window

Very bad example I know, and it's in VBA.

It does show you how you could reference a range so you don't need to use Selection.

GrahamSkan

This code is only syntax-tested (in the VB editor), but even if it doesn't work , it should give you the idea.

Public Sub ProcessDocumentToWord()
        Dim objWord As Word.Application
        Dim objDoc As Word.Document
        Dim strWord As String
        Dim objSelection As Word.Selection
        Dim strInputFile As String
        Dim objPageNumber As String
        Dim objNewDoc As Word.Document
        Dim misValue As Object = System.Reflection.Missing.Value
        Dim objRange As Word.Range
        strInputFile = frmGetReferences.lblInputFile.Text
        objWord = CreateObject("Word.Application")
        objNewDoc = objWord.Documents.Add(misValue)
        objNewDoc.SaveAs(frmGetReferences.lblOutputFolder.Text & "" & frmGetReferences.txtOutputFilename.Text & ".doc")
        objDoc = objWord.Documents.Open(strInputFile)
        objRange = objDoc.Range
        With objRange.Find()
            .Forward = True
            .MatchWildcards = True
            .Text = "\(*\)"

            MessageBox.Show("You have selected DOC")

            Do While True

                If .Execute() Then
                    strWord = objRange1.Text
                    objPageNumber = objRange1.Information(Word.WdInformation.wdActiveEndPageNumber)
                    MessageBox.Show(strWord & " , Page" & objPageNumber)
                    objNewDoc.Bookmarks("\EndOfDoc").Range.Text = strWord & " , Page" & objPageNumber & vbCr
                Else
                    Exit Do
                End If
            Loop
        End With
        objDoc.Close()
        objNewDoc.Close()
        objWord.Quit()

        objDoc = Nothing
        objWord = Nothing
        objNewDoc = Nothing

    End Sub

Open in new window

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

G_M

ASKER

Worked first time... Thank you very much. I'll have a read through it properly and get my head around it for the next time. Will this method also work for Excel?

GrahamSkan

I don't work in in Excel so much, but there I also try to avoid using Selection.

The Selection object appears in much code because the code is hacked from recorded macros which necessarily depend on the user's selection to define ranges.

There is no point in doing, say

Cells(1,1).Select
Selection.Value = "Something"

Instead of

Cells(1,1).Value = "Something"

G_M

ASKER

Thanks again for your help Graham... I'll work through the Excel stuff later.

Cheers
G_M

Norie

This should work for Excel.

Dim objWord As Microsoft.Office.Interop.Word.Application
Dim objDoc As Microsoft.Office.Interop.Word.Document
Dim strWord As String
Dim objWordRange As Microsoft.Office.Interop.Word.Range
Dim strInputFile As String
Dim objPageNumber As String

Dim objXL As Microsoft.Office.Interop.Excel.Application
Dim objWB As Microsoft.Office.Interop.Excel.Workbook
Dim objWS As Microsoft.Office.Interop.Excel.Worksheet
Dim objXLRange As Microsoft.Office.Interop.Excel.Range

Dim boolFileExists As Boolean


' strInputFile = frmGetReferences.lblInputFile.Text
objWord = CreateObject("Word.Application")

' objNewDoc.SaveAs(frmGetReferences.lblOutputFolder.Text & "" & frmGetReferences.txtOutputFilename.Text & ".doc")strInputFile = "C:\Test.docx"
objDoc = objWord.Documents.Open(strInputFile)

objXL = CreateObject("Excel.Application")

boolFileExists = System.IO.File.Exists("C:\DocRefs.xlsx")

If boolFileExists Then

    objWB = objXL.Workbooks.Open("C:\DocRefs.xlsx")
Else
    objWB = objXL.Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
End If

objWS = objWB.Worksheets(1)

objXLRange = objWS.Range("A" & objWS.Rows.Count).End(XlDirection.xlUp)

If objXLRange.Row = 1 Then

    objXLRange.Value = "Reference"
    objXLRange.Offset(, 1).Value = "Page"
    objXLRange.Offset(, 2).Value = "Document"
End If

objXLRange = objXLRange.Offset(1)

objWordRange = objDoc.Range

With objWordRange.Find

    .Forward = True
    .MatchWildcards = True
    .Text = "\(*\)"

    Do While True

        .Execute()
        If .Found Then
            strWord = objWordRange.Text
            objPageNumber = objWordRange.Information(Microsoft.Office.Interop.Word.WdInformation.wdActiveEndPageNumber)

            'MessageBox.Show(strWord & " , Page" & objPageNumber)

            objXLRange.Value = strWord & " , Page" & objPageNumber
            objXLRange.Value = strWord
            objXLRange.Offset(, 1).Value = "Page " & objPageNumber
            objXLRange.Offset(, 2).Value = objDoc.Name

            objXLRange = objXLRange.Offset(1)
        Else
            Exit Do
        End If
    Loop
End With

If Not boolFileExists Then
    objWB.SaveAs ("C:\DocRefs.xlsx")
End If



objWB.Close (True)

objXL.Quit()

objWB = Nothing
objXL = Nothing

objDoc.Close()

objWord.Quit()

objDoc = Nothing
objWord = Nothing

Open in new window