从MS Word到Excel查找并复制（文本和表格） [英] Find and copy (text and table) from MS Word To Excel

问题描述

大家好，



我相信之前有人问过这个问题，但我找不到任何东西，我只是Excel VBA的初学者。



我有大约900张MS Word格式的发票，我需要查找并复制发票编号，日期，中间的表格，以及
的总金额。 



应该看起来像这样

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

发票编号	Date	Quantity	描述	每件商品价格	金额	总计
AA000123	2017/08/15	1	Apple	$ 2.00	$ 2.00	$ 2.00
AA000124	2017/08/15	5	Orange	$ 2.00	$ 10.00	$ 10.00

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

推荐答案

您需求的代码非常具体;它取决于准确知道文档中哪些段落包含发票号和日期​​。还有发票表中有多少数据行的问题（s ）在给定的文档中可能包含。

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.

以下代码应该可以帮助您开始。将它添加到Excel工作簿后，您只需选择输出工作表并运行宏 宏;对于一个文件夹（代码允许您选择），发票数据将从该文件夹中的所有docx文件中提取
。代码假定Invoice＃和Date分别在第一和第二段中 - 并且这些段落中没有其他内容。如果它们不在这些段落中，则需要相应地调整strInvNo& strDate变量中的段落引用
。注意comm关于添加对Word对象模型的引用的代码。

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

这篇关于从MS Word到Excel查找并复制（文本和表格）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！