Find and copy (text and table) from MS Word To Excel RRS feed

  • Question

  • Hi All,

    I am sure someone asked this question before but I cannot find anything and I am only a beginner with Excel VBA.

    I have about 900 invoices in MS Word format where I need to find and copy the invoice number, date, the table in the middle, and the total amount. 

    and should look something like this

    Invoice Number Date Quantity Description Price per Item Amount Total
    AA000123 2017/08/15 1 Apple $2.00 $2.00 $2.00
    AA000124 2017/08/15 5 Orange $2.00 $10.00 $10.00

    Example Below

    Invoice number: AA000123
    Date: 2017/08/15

    Quantity Description Price per Item Amount
    1 Apple $2.00 $2.00
    Total $2.00

    Invoice number: AA000124
    Date: 2017/08/15

    Quantity Description Price per Item Amount
    5 Orange $2.00 $10.00
    Total $10.00
    Tuesday, August 15, 2017 1:01 PM

All replies

  • The code for your requirements is very specific; it depends on knowing precisely which paragraphs in the documents contain the Invoice # and Date. There is also the question of how many data rows the invoice table(s) in a given document may contain.

    The following code should get you started. After adding it to the Excel workbook, all you need do is select the output worksheet and run the macro against a folder (which the code allows you to select) and the invoice data will be extracted from all docx files in that folder. The code assumes the Invoice # and Date are in the first and second paragraphs, respectively - and that nothing else is in those paragraphs. If they're not in those paragraphs, you'll need to adjust the paragraph references in the strInvNo & strDate variables accordingly. Note the comment in the code about adding a reference to the Word object model.

    Sub GetInvoiceData() 'Note: this code requires a reference to the Word object model. See under the VBE's Tools|References. Application.ScreenUpdating = False Dim strFolder As String, strFile As String, strInvNo As String, strDate As String Dim wdApp As New Word.Application, wdDoc As Word.Document, wdTbl As Word.Table Dim WkSht As Worksheet, i As Long, r As Long, c As Long strFolder = GetFolder If strFolder = "" Then Exit Sub Set WkSht = ActiveSheet i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row 'Disable any auto macros in the documents being processed wdApp.WordBasic.DisableAutoMacros strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc
        strInvNo = Trim(Split(Split(.Paragraphs(1).Range.Text, vbCr)(0), ":")(1))
        strDate = Trim(Split(Split(.Paragraphs(2).Range.Text, vbCr)(0), ":")(1))
    For Each wdTbl In .Tables With wdTbl If Split(.Range.Cells(1).Range.Text, vbCr)(0) = "Quantity" Then For r = 2 To .Rows.Count - 1 If IsNumeric(Split(.Range.Cells(1).Range.Text, vbCr)(0)) Then i = i + 1 WkSht.Cells(i, 1).Value = strInvNo: WkSht.Cells(i, 2).Value = strDate For c = 1 To 4 WkSht.Cells(i, c + 2).Value = Split(.Cell(r, c).Range.Text, vbCr)(0) Next End If Next End If End With Next .Close SaveChanges:=False End With strFile = Dir() Wend wdApp.Quit Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function

    Paul Edstein
    [MS MVP - Word]

    Tuesday, August 15, 2017 9:47 PM
  • Hello Frankie,

    As Paul said, the code would be specific for your document. If the code shared by Paul doesnt work for you and you do not know how to modify, you could upload your file into OneDrive and share it here. If your issue has been resolved, i suggest you mark helpful post as answer to close this thread or you could share your solution here. Thanks for your understanding.



    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact

    Wednesday, August 30, 2017 9:54 AM