PDA

View Full Version : Solved: Export from Word form to Excel



yogin
07-08-2010, 05:29 AM
Hello, I would word template that are saved with multiple file name in a folder, and I need to export only the data fields I need into an excel spreadsheet. Is this possible? sorry i am not very good with programming so can some one please help me with this? I have attached the word form which i am tring get information from to excel.

yogin
07-08-2010, 05:32 AM
second excel file is attached as as well.. i am tring get this information from some of the old template used and get a report on this. Can someone please help.

Tinbendr
07-08-2010, 08:32 AM
Drop this into a Excel module.
If something is out of place, I've commented the code enough that i think you should be able to straighten it out.

Sub StdInvAuth()

'Add Word object reference library.
'Tools->References - Check the Microsoft Word Object Libary box
Dim WB As Workbook
Dim WS As Worksheet
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document
Dim WrdFld As Word.Bookmark
Dim xRow As Long
Dim aCol As Long
Dim A As Long
Dim Fname As Variant

Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next

Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

'Prompt to select file
Fname = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx")

Set oDoc = oWord.Documents.Open(Fname, Visible:=False)

'Get the last row
xRow = WS.Range("A65536").End(xlUp).Row
With WS
'Filename
.Cells(xRow + 1, 1) = oDoc.Name
'Co CODE
.Cells(xRow + 1, 2) = oDoc.FormFields(1).Result
'Vendor #
.Cells(xRow + 1, 3) = oDoc.FormFields(2).Result
'Vendor name
.Cells(xRow + 1, 4) = oDoc.FormFields(3).Result
'Invoice #
.Cells(xRow + 1, 5) = oDoc.FormFields(5).Result
'Text
.Cells(xRow + 1, 5) = oDoc.FormFields(6).Result

'Invoice Coding Details
aCol = 6
For A = 7 To 31 Step 5

'CO CODE
.Cells(xRow + 1, aCol) = oDoc.FormFields(A + 1).Result
'G/L ACCT
.Cells(xRow + 1, aCol + 1) = oDoc.FormFields(A).Result
'Cost Centre
.Cells(xRow + 1, aCol + 2) = oDoc.FormFields(A + 4).Result
aCol = aCol + 3
Next A
End With

oDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
oWord.Quit
End If

'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing

'quit
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If WordWasNotRunning Then
oWord.Quit
End If

End Sub

yogin
07-19-2010, 04:59 PM
Thanks alot for this and sorry did not get back to earlier....the program did exactly what i wanted however i had to select each file for this but it worked out fine. Thanks alot once again.

Tinbendr
07-20-2010, 05:26 AM
... however i had to select each file for this but it worked out fine. Thanks a lot once again.Oops! Forgot that part. Glad it worked out for you anyway.

There is a typo for others that might use the code.

In the last line that inserts the text, the five is supposed to be a six. Should be
'Text
.Cells(xRow + 1, 6) = oDoc.FormFields(6).Result
Please mark the message solved. Thanks!

yogin
07-20-2010, 05:49 AM
:clap::bow:

yogin
07-21-2010, 06:06 PM
hi tin, can you please help me once again to modify the macro so that it will open each file automatically as i haave to run this each week now.

Tinbendr
07-23-2010, 07:19 PM
OK Finally squeezed out a little this this evening. (I'm ready to put my feet up for a while.)

Select one or as many as you need.

Change paths accordingly for a default startup.

This doesn't have any error checking, just an error trap. I wouldn't select more than a few at a time until you're confident in the code.

Good luck!

Sub StdInvAuth()

'Add Word object reference library.
'Tools->References - Check the Microsoft Word Object Libary box
Dim WB As Workbook
Dim WS As Worksheet
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document
Dim WrdFld As Word.Bookmark
Dim xRow As Long
Dim aCol As Long
Dim A As Long
Dim Fname As Variant
Dim SourceDrive As String
Dim SourcePath As String
Dim NumFiles As Long

Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next

'Change accordingly
SourceDrive = "C:"
SourcePath = "\Documents and Settings\Owner\My Documents\VBA\32940\"

ChDrive SourceDrive
ChDir SourcePath

Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler



'Prompt to select file
Fname = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx", , , , True)

For NumFiles = 1 To UBound(Fname)

Set oDoc = oWord.Documents.Open(Fname(NumFiles), Visible:=False)

'Get the last row
xRow = WS.Range("A65536").End(xlUp).Row
With WS
'Filename
.Cells(xRow + 1, 1) = oDoc.Name
'Co CODE
.Cells(xRow + 1, 2) = oDoc.FormFields(1).Result
'Vendor #
.Cells(xRow + 1, 3) = oDoc.FormFields(2).Result
'Vendor name
.Cells(xRow + 1, 4) = oDoc.FormFields(3).Result
'Invoice #
.Cells(xRow + 1, 5) = oDoc.FormFields(5).Result
'Text
.Cells(xRow + 1, 6) = oDoc.FormFields(6).Result

'Invoice Coding Details
aCol = 6
For A = 7 To 31 Step 5

'CO CODE
.Cells(xRow + 1, aCol) = oDoc.FormFields(A + 1).Result
'G/L ACCT
.Cells(xRow + 1, aCol + 1) = oDoc.FormFields(A).Result
'Cost Centre
.Cells(xRow + 1, aCol + 2) = oDoc.FormFields(A + 4).Result
aCol = aCol + 3
Next A
End With
Next
oDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
oWord.Quit
End If

'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing

'quit
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If WordWasNotRunning Then
oWord.Quit
End If

End Sub

a11041989
10-04-2010, 08:38 AM
Hi,

Sorry to hijack the post, but I need something similar. I have a few forms for new product announcements etc, and I need to be able to extract the info from them into Excel, but I can't figure out how to change the code so it fits my form.

I've already got some code in there to give the form a unique reference number, and to pull a description from a message box-style field.

I've attached a copy of the form, but the copy I'll be using is actually a .dotm file (wouldn't let me upload that).

Thanks!

Tinbendr
10-04-2010, 06:58 PM
I absolutely hate working with content controls!

But here's a demo of how to access them.

You can just iterate through them. If the format will always be the same, then just pick them by number. (Not very safe IMHO) Or you can give them titles (which is visible in the document as a folder tab) or use the Tag field.

Sub test()
Dim lCount As Long
Dim CC As ContentControl
For Each CC In ActiveDocument.ContentControls
lCount = lCount + 1
Debug.Print lCount & CC.Title & CC.Tag
Next
End Sub

Kenneth Hobs
10-04-2010, 07:59 PM
Welcome to the forum!

Rather than hijacking a thread, particularly one that is old, just post a link to it from your new thread.

The example code that Tinbender posted on 7/23/10 should be close to what you want. The code that you posted in your file is MSWord code, not Excel code. While recording the macro in MSWord is a start, you must adapt it to work in Excel. Late bound methods like that posted do not let intellisense work. Use early bound methods for development and late for final code.

I recommend setting the titles in the MSWord files content controls as well.

Similar in concept, this example puts data into the MSWord file as opposed to the MSWord to Excel method that you wanted. I just post it to show how I used the title for the content controls.
'http://www.mrexcel.com/forum/showthread.php?t=333200
Sub FillForm()
Dim wdApp As Object, WD As Object, rn As Long
rn = ActiveCell.Row
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set WD = wdApp.Documents.Open(ThisWorkbook.Path & "\Car Information Page.doc")

wdApp.Visible = True
With WD
.FormFields("Brand").Result = Cells(rn, "B")
.FormFields("Model").Result = Cells(rn, "C")
.FormFields("Chasis").Result = Cells(rn, "D")
.FormFields("Engine").Result = Cells(rn, "E")
.FormFields("Color").Result = Cells(rn, "F")
.FormFields("YearMonth").Result = Cells(rn, "G").Value & "/" & Cells(rn, "H").Value
End With

Set WD = Nothing
Set wdApp = Nothing
End Sub