vba 将 Word 文档中的数据提取到 Excel 电子表格

Extract Data from Word Document to an Excel SpreadSheet

提问by Srinivasa

I have a requirement to extract a value from a word document on a daily basis and write it to an excel workbook. I currently do this manually and it is border line regarding the most efficient method for me

我需要每天从 Word 文档中提取一个值并将其写入 Excel 工作簿。我目前手动执行此操作，这是对我来说最有效方法的边界线

1. Using Excel file create a vba script and add any word document references.

1. 使用 Excel 文件创建一个 vba 脚本并添加任何 Word 文档引用。

2 Using the word navigate to the table “9. STOCKS...” (extracted example below – Appendix A) and read the Diesel (ltrs) daily usage highlighted in red.

2 使用单词导航到表格“9. 股票...”（以下摘录示例 – 附录 A）并阅读以红色突出显示的柴油 (ltrs) 日常使用情况。

3.Write this value to a spreadsheet cell.

3.将此值写入电子表格单元格。

1. The date for this value is also key but it held in another part of the word document (Appendix B). Dates are also in the file name but we trust the internal value more than the word document name. With knowledge from points 3 and 4 extract the associated date to an adjacent spreadsheet cell.

4. 此值的日期也是关键，但它保存在 Word 文档的另一部分（附录 B）中。日期也在文件名中，但我们更相信内部值而不是文档名称。根据第 3 点和第 4 点的知识，将相关日期提取到相邻的电子表格单元格中。

The table is displayed below, because of the formatting I'm not able to send you the exact table but I will be able to send the values of it.

该表格显示在下方，由于格式的原因，我无法向您发送确切的表格，但我将能够发送它的值。

9.STOCKS (As of 00:01 hrs on Day of report issue). Stock Held Daily Usage Minimum Stock

9.STOCKS（截至报告发布日的 00:01）。每日持有量 最低库存量

Diesel (ltrs)
390436 1501225000

柴油（升）
390436 1501225000

Nitrogen (mm)
35 1 19 Champion 1033 (totes)
15 1 4 Nexguard (Boilers) 4
0.25 4 x 200 ltrs

氮气 (mm)
35 1 19 Champion 1033 (
totes ) 15 1 4 Nexguard (Boilers) 4
0.25 4 x 200 ltrs

Appendix B: Beatrice Period of Report: 00:01 – 24:00 10th August 2010

附录 B：Beatrice 报告时间：2010 年 8 月 10 日 00:01 – 24:00

If you have any doubts regarding my question please get back to me, I appreciate your efforts and wanted to thanks in advance

如果您对我的问题有任何疑问，请回复我，感谢您的努力，并希望提前致谢

回答by MikeD

here's some code making use of late binding (declare objects rather than word.application etc). From Excel 2003, it

这是一些使用后期绑定的代码（声明对象而不是 word.application 等）。从Excel 2003 开始，它

1. opens a WORD document
2. searches for string "minimum stock"
3. moves the cursor some lines/words further
4. expands/selects the WORD cursor
5. pastes this WORD selection into EXCEL

1. 打开一个 WORD 文档
2. 搜索字符串“最低库存”
3. 将光标进一步移动一些行/词
4. 展开/选择 WORD 光标
5. 将此 WORD 选择粘贴到 EXCEL 中

steps 2-5 are repeated for "Period of report:" (note that the ":" is a word boundary, so we need to jump 8 words to the right to arrive at the date)

对“Period of report:”重复步骤2-5（注意“:”是一个词边界，所以我们需要向右跳8个词才能到达日期）

For WORD I copied the text from your Q just as is (no table, just plain text). If you use tables instead, you may need to play with the units of the various Movestatements (e.g. for cells unit:=12); the strategy remains the same: find a constant text, move cursor to final destination, expand selection, create a word range and transfer.

对于 WORD，我按原样复制了您 Q 中的文本（没有表格，只是纯文本）。如果您改用表格，则可能需要使用各种Move语句的单位（例如，单元格unit:=12）；策略保持不变：找到一个固定的文本，将光标移动到最终目的地，扩大选择范围，创建一个单词范围并转移。

Both items are placed into the current cell in Excel and its right neighbor.

这两个项目都被放置在 Excel 中的当前单元格及其右侧相邻单元格中。

Sub GrabUsage()
Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range

    Set ExR = Selection ' current location in Excel Sheet

    'let's select the WORD doc
    Set FD = Application.FileDialog(msoFileDialogOpen)
    FD.Show
    If FD.SelectedItems.Count <> 0 Then
        FName = FD.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' open Word application and load doc
    Set WApp = CreateObject("Word.Application")
    ' WApp.Visible = True
    Set WDoc = WApp.Documents.Open(FName)

    ' go home and search
    WApp.Selection.HomeKey Unit:=6
    WApp.Selection.Find.ClearFormatting
    WApp.Selection.Find.Execute "Minimum Stock"

    ' move cursor from find to final data item
    WApp.Selection.MoveDown Unit:=5, Count:=1
    WApp.Selection.MoveRight Unit:=2, Count:=2

    ' the miracle happens here
    WApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1

    ' grab and put into excel        
    Set WDR = WApp.Selection
    ExR(1, 1) = WDR ' place at Excel cursor

    'repeat
    WApp.Selection.HomeKey Unit:=6
    WApp.Selection.Find.ClearFormatting
    WApp.Selection.Find.Execute "Period of Report:"
    WApp.Selection.MoveRight Unit:=2, Count:=8
    WApp.Selection.MoveRight Unit:=2, Count:=3, Extend:=1

    Set WDR = WApp.Selection
    ExR(1, 2) = WDR ' place in cell right of Excel cursor

    WDoc.Close
    WApp.Quit

End Sub

You can create a button and call that sub from there, or link GrabUsage() to a function key.

您可以创建一个按钮并从那里调用该子项，或者将 GrabUsage() 链接到功能键。

I commented out the WApp.Visible = Truebecause in production you don't want WORD even to show up, but you will need it for debugging and playing with the cursor movements.

我注释掉了WApp.Visible = True因为在生产中你甚至不希望 WORD 出现，但是你需要它来调试和玩光标移动。

The disadvantage of late binding (and not using references to the Word library) is the hardcoding of units (6=story, 5=line, 2=word) instead of using Word enumerations, but I sometimes get OS crashes with early binding .... not very sexy but it seems to work.

后期绑定（并且不使用对 Word 库的引用）的缺点是单元的硬编码（6=故事，5=行，2=单词）而不是使用 Word 枚举，但有时我会因早期绑定而导致操作系统崩溃.. .. 不是很性感，但似乎有效。

The FileDialog object needs a reference to the MS Office Office Library. AFAIK this is standard in Excel 2003, but better to check than to crash.

FileDialog 对象需要对 MS Office Office 库的引用。AFAIK 这是 Excel 2003 中的标准，但最好检查而不是崩溃。

And I didn't include code to check if the items are really found; I leave this to your creativity.

而且我没有包含代码来检查是否真的找到了这些物品；我把这留给你的创造力。

Hope that helps.

希望有帮助。