提取word文档中特定信息到Excel，word文档结构如下：

   
    一个文档中，有多个这样的缴费清单，我们要提取的是一些固定关键字之后的数据。
所以，我们循环文档的所有段落，如果包含【物业管理清册】关键字，则获取他的下两行数据，并且提取关键字。

Sub 循环打开工作簿()
On Error GoTo 1
k = 1
Rows("2:65536").Clear '清除上次数据
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
pth = Application.GetOpenFilename("文件(*.doc*),*.doc*", , "请选择文件", , False) '打开doc后缀的文档
If pth = "False" Then Exit Sub '如果用户选择了取消，直接退出
Set doc = CreateObject("word.application") '创建Word对象
doc.Visible = True '显示word主程序
Set wd = doc.Documents.Open(pth) '打开word文档，赋值给对象变量wd
For Each tbl In wd.tables '删除文档中所有的表格，因为表格过多，影响循环段落的效率。 用
  tbl.Delete
Next
For i = 1 To wd.Paragraphs.Count - 2 '循环到倒数第三段
    a = wd.Paragraphs(i).Range.Text '获取这几段的内容，分别赋值给a、b、c变量
    b = wd.Paragraphs(i + 1).Range.Text
    c = wd.Paragraphs(i + 2).Range.Text
    If  InStr(a, "物业管理费缴费清册") Then '开始取数据
     k = k + 1
     Cells(k, 1) = k - 1 '序号
     Cells(k, 2) = l(Split(Split(b, "：")(1), "面积")(0)) '楼号楼室
     Cells(k, 3) = l(Split(Split(b, "面积")(1), "㎡")(0)) '面积
     Cells(k, 4) = l(Split(Split(c, "姓名")(1), "电话")(0)) '姓名
     Cells(k, 5) = l(Split(Split(c, "电话")(1), "月缴费")(0)) '电话
     Cells(k, 6) = l(Split(Split(c, "月缴费")(1), "元")(0)) '月缴费
     Cells(k, 7) = l(Split(Split(c, "年缴费")(1), "元")(0)) '年缴费
   End If
Next
1: wd.Close False '关闭原始文档，并且不保存
doc.Quit '关闭Word主程序
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
If Err.Number <> 0 Then
  MsgBox Err.Description & vbCrLf & "提取出现错误，联系作者解决！"
End If
MsgBox "提取完成！"
End Sub

Function l(s)
 l = Replace(s, "：", "") '去除冒号自定义函数
End Function

如何将上述word vba代码改成VFP代码，请高手赐教。万分感谢！！！

[此贴子已经被作者于2021-9-8 13:58编辑过]

难了，很难做到，因为WORD的表格，本来就没有EXCEL的表格正规。

VFP直接用word.application就可以吧
测试就要提供相关文件

相关测试文件已上传，详见附件。烦请各位大佬帮忙，万分感谢！

只见到一个DOC文件，没清楚EXCEL表格式
先写入DBF，可由DBF再转到EXCEL

cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
CREATE CURSOR tt (序号 I, 楼号 C(30), 面积 C(10), 姓名 C(10), 电话 C(20), 月缴费 C(10), 年缴费 C(10))
pth = cDefPath+"tmp.doc"
COPY FILE 提取word文档中特定信息到Excel.doc TO (pth)
doc = CREATEOBJECT("word.application")
doc.Visible = 1
wd = doc.Documents.Open(pth)
FOR EACH tbl IN wd.tables  &&删除文档中所有的表格
  tbl.Delete
ENDFOR
k = 1
FOR i=1 TO wd.Paragraphs.Count-2 STEP 3
    b = wd.Paragraphs(i+1).Range.Text
    c = wd.Paragraphs(i+2).Range.Text
    INSERT INTO tt VALUES (k,;
        STREXTRACT(b,"："," "),;
        STREXTRACT(b,"："," ",2),;
        STREXTRACT(c,"："," "),;
        STREXTRACT(c,"："," ",2),;
        STREXTRACT(c,"：","元",3),;
        STREXTRACT(c,"：","元",4))
    k = k + 1
ENDFOR
wd.Close(0)
doc.Quit
DELETE FILE (pth)
SELECT * FROM tt

@ 吹水佬 非常感谢指点！！！能否将“收费标准”也写入临时表文件tt.dbf中，盼指点。

CREATE CURSOR tt (序号 I,楼号 C(30),面积 C(10),收费标准 C(15),姓名 C(10),电话 C(20),月缴费 C(10),年缴费 C(10))
pth = cDefPath+"tmp.doc"
COPY FILE 提取word文档中特定信息到Excel.doc TO (pth)
doc = CREATEOBJECT("word.application")
doc.Visible = 1
wd = doc.Documents.Open(pth)
FOR EACH tbl IN wd.tables  &&删除文档中所有的表格
  tbl.Delete
ENDFOR
k = 1
FOR i=1 TO wd.Paragraphs.Count-2 STEP 3
    b = wd.Paragraphs(i+1).Range.Text
    c = wd.Paragraphs(i+2).Range.Text
    INSERT INTO tt VALUES (k,;
        STREXTRACT(b,"："," "),;
        STREXTRACT(b,"："," ",2),;
        STREXTRACT(b,"：","",3),;
        STREXTRACT(c,"："," "),;
        STREXTRACT(c,"："," ",2),;
        STREXTRACT(c,"：","元",3),;
        STREXTRACT(c,"：","元",4))
    k = k + 1
ENDFOR
wd.Close(0)
doc.Quit
DELETE FILE (pth)
SELECT * FROM tt

@吹版，学习啦，谢谢！

@ 吹水佬 非常感谢指点！！！