yogin
07-20-2010, 10:48 PM
hi, i have already got help from tim to do what i want but i need to modify the below VBA macro so that it will select file automatically and get the data i want into excel.
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
'Text
.Cells(xRow + 1, 5) = oDoc.FormFields(4).Result
'Invoice Coding Details
aCol = 6
For A = 5 To 28 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
Can you please help??
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
'Text
.Cells(xRow + 1, 5) = oDoc.FormFields(4).Result
'Invoice Coding Details
aCol = 6
For A = 5 To 28 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
Can you please help??