| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 307 人关注过本帖
标题:如何将word vba代码改写成VFP代码
只看楼主 加入收藏
王咸美
Rank: 1
等 级:新手上路
帖 子:384
专家分:0
注 册:2018-1-4
结帖率:95.29%
收藏
已结贴  问题点数:20 回复次数:8 
如何将word vba代码改写成VFP代码
提取word文档中特定信息到Excel.zip (7.98 KB)

提取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编辑过]

搜索更多相关主题的帖子: 文档 代码 Split Application word 
2021-09-08 12:02
gs2536785678
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:31
帖 子:439
专家分:1301
注 册:2017-7-16
收藏
得分:0 
难了,很难做到,因为WORD的表格,本来就没有EXCEL的表格正规。
2021-09-08 16:48
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:319
帖 子:8182
专家分:36077
注 册:2014-5-20
收藏
得分:0 
VFP直接用word.application就可以吧
测试就要提供相关文件
2021-09-08 19:14
王咸美
Rank: 1
等 级:新手上路
帖 子:384
专家分:0
注 册:2018-1-4
收藏
得分:0 
相关测试文件已上传,详见附件。烦请各位大佬帮忙,万分感谢!
2021-09-09 11:51
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:319
帖 子:8182
专家分:36077
注 册:2014-5-20
收藏(1)
得分:20 
以下是引用王咸美在2021-9-9 11:51:43的发言:

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

只见到一个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
2021-09-09 16:21
王咸美
Rank: 1
等 级:新手上路
帖 子:384
专家分:0
注 册:2018-1-4
收藏
得分:0 
@ 吹水佬 非常感谢指点!!!能否将“收费标准”也写入临时表文件tt.dbf中,盼指点。
2021-09-09 18:44
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:319
帖 子:8182
专家分:36077
注 册:2014-5-20
收藏
得分:0 
回复 6楼 王咸美
程序代码:
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
2021-09-09 19:56
schtg
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:54
帖 子:1055
专家分:1750
注 册:2012-2-29
收藏
得分:0 
@吹版,学习啦,谢谢!
2021-09-10 06:23
王咸美
Rank: 1
等 级:新手上路
帖 子:384
专家分:0
注 册:2018-1-4
收藏
得分:0 
@ 吹水佬 非常感谢指点!!!
2021-09-10 07:51
快速回复:如何将word vba代码改写成VFP代码
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.194749 second(s), 9 queries.
Copyright©2004-2021, BCCN.NET, All Rights Reserved