word表导入VFP中（试用）
我周围的职场中会用数据库的人少，制表几乎都是word、excel当家，好容易完成数据输入，一旦要进行内容删减、调序，只能用复制、粘贴或拖放的方法进行，遇到数据量大时，非常地繁琐，为此，本人开发了将word表导入到VFP的程序段，导入的数据在VFP中调序筛减后，重新输出到word中，效率提升了很多，供大家参考。*本程序用于逐行读取WORD文档中各个表格的数据,适用于较规则表.
*WORD中没有象EXCEL中的单元格合并的属性判断,也没有合并几行几列的判断（WORD的BUG，VBA语言未升级）,合并单元格读值通过变通编程完成.
*对于同行单元格合并,导入的数据将递次前移,同列单元格的合并,将导入同一值,跨行跨列的合并,左上角所在列取同值,其它单元格置空.
*单元格中有回车符等,有时会造成数据写入/代换错误（中断）,可修改Word文档纠正.
*因单元格合并导致数据导入“错位”，可在首次导入后重新输出为Word二维表，在二维表中“拖放”纠偏后，再从二维表导入即可纠正。
*Word单元格的“值”均以文本保存，没有数据类型，难于通过程序精准判定某列是N型还是D型等，须在导入后手动修改库结构。
*单个WORD文档中各表总行数大于500行时，数据传递速度明显变慢，数据行越多，导入速度越慢，可设法将各表分散在多个文档中分别导入再合并。
private all
set talk off
set scoreboard off
set status off
set safety off
set exact on
gdkm=dbf(1)
dimension fac(300),name1(300),cdjl(300),rec1(300)
set color to +7/1
clear
xjkm1=getfile("doc")
xjkm1=trim(xjkm1)
if trim(xjkm1)=""
wait "源文件名不能为空" window at 16,52 nowait
return
endif
jhh=1
do while jhh<=len(xjkm1)
if left(right(xjkm1,jhh),1)<>"\"
jhh=jhh+1
else
xjkm2=right(xjkm1,jhh-1)
exit
endif
enddo
xjkm2=trim(xjkm2)
*去除文件名中可能含有的非法字符
xjkm2=chrtranc(xjkm2,"()（）","")
xjkm2=chrtranc(xjkm2,[!?\*|"'<>:/ ],[])
xjkm2=chrtranc(xjkm2,'！？、，。；“”‘’《》：','')
zdzs2=left(xjkm2,len(xjkm2)-4)
if trim(zdzs2)=""
wait "目标文件名不能为空" window at 16,52 nowait
return
endif
xjkm2=sys(5)+sys(2003)+"\"+left(trim(xjkm2),len(trim(xjkm2))-4)
if upper(trim(xjkm1))=upper(trim(xjkm2))
wait "目标文件与源文件重名" window at 16,52 nowait
return
endif
copy structure to ls-ext extended
use
create table lscfzk (导入错误 C(90))
use
wait clear
messagebox( "Word文档[&zdzs2.]中各表格将导入到[&zdzs2.]系列库，";
+"按以下要求对文档预处理以避免数据导入错误:";
+chr(13)+chr(13)+"1、Word文档中不同的表格将导入不同的数据库中，表格外的内容不能导入；";
+chr(13)+"2、各表指定行各单元格的内容将形成库结构,应当限长10个字符且没有合并单元格；";
+chr(13)+"3、各表格的样式可不同；各表格尽可能是规则表；各单元格以“文本”导入；";
+chr(13)+"4、行合并格导入的数据将递次前移，列合并格同值,行列合并格同列同值；";
+chr(13)+"5、单元格中的数据多行或折行，无论是否存在分段，一律作为一个整体导入；";
+chr(13)+"6、如果数据情形复杂，可在每张表第一行人为填入“纯文本”数据引导过渡；";
+chr(13)+"7、数据导入后应与Word原有数据进行比对勘察正误。",48,"导入Word表的预处理措施")
clear
wa=messagebox( "现在开始导入数据?",4+32+256,"Word表导入数据库")
if wa=6
zljlh=messagebox("快速构建库结构请选“是”，精细扫描库结构请选“否”。",4+32+0,"扫描word表结构")
if file(xjkm1)
set color to +7/1,+6/4
wait clear
clear
wait "正在访问Word软件......" at 18,50 window nowait
tdsj=inkey(0.1)
WordApp=CreateObject("Word.application")
if type("WordApp")#"O"
wait clear
messagebox( "访问Word失败！请检查是否正确安装Word软件！",48,"没有安装Word")
WordApp.Quit
release WordApp
erase ls-ext.dbf
erase ls-ext.fpt
use &gdkm
return
endif
WordApp.documents.open(xjkm1)
*WORD调整为普通视图
If WordApp.ActiveWindow.View.SplitSpecial=0
WordApp.ActiveWindow.ActivePane.View.Type=1
Else
WordApp.ActiveWindow.View.Type=1
Endif
*word以后台方式运行
WordApp.Visible =.f.
*YDLH记录导入的表格数
YDLH=1
*CXHH记录导入的行数
cxhh=1
*sttjh记录当前文档中的表格数量
sttjh=WordApp.ActiveDocument.Tables.count
gdzd=1
cdbh="手动"
spk=1
gjzd1=1
sele 1
DO WHILE ydlh<=sttjh
clear
wait clear
*逐一选中各表的第一单元格以选中该表
WordApp.ActiveDocument.Tables(ydlh).Cell(1,1).Select
*取得表格的行数,Tables的参数以取(1)为宜,下同.
spjl1=WordApp.Selection.Tables(1).Rows.Count
*取得表格的列数
spjl2=WordApp.Selection.Tables(1).Columns.Count
*取得第1行最末一列，以便于后位插入列，保证表格尾列合并格或行列合并格数据导入完全。
szpk=spjl2
czd2=alltrim(WordApp.Selection.Tables(1).CELL(1,szpk).Range.Text)
czd2=alltrim(chrtranc(czd2," "," "))
*去掉单元格文本尾部的回车符
czd2=left(czd2,len(czd2)-2)
do while (chr(2)$czd2.or.""$czd2).and.szpk>1
szpk=szpk-1
czd2=alltrim(WordApp.Selection.Tables(1).CELL(1,szpk).Range.Text)
czd2=alltrim(chrtranc(czd2," "," "))
*去掉单元格文本尾部的回车符
czd2=left(czd2,len(czd2)-2)
enddo
*选中第一行最末列，后位插入列。
WordApp.ActiveDocument.Tables(ydlh).Cell(1,szpk).Select
WordApp.Selection.InsertColumnsRight
*取得表格的列数
spjl2=WordApp.Selection.Tables(1).Columns.Count
sjxsw=spjl2
if cdbh="自动"
*自动方式mbjlh、gjzd2不变
else
*手动方式mbjlh取最大行号,gjzd2取最大列号.
mbjlh=spjl1
gjzd2=spjl2
endif
zd=gdzd+1
if cdbh="手动"
*一旦选了"自动"方式，后面的各表全进入自动读取，不再回到手动方式。
define windows win1 from 7,9 to 21,66 system title "导入Word表格" color scheme 1
activate windows win1
move windows win1 center
@1,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表列字段名所在行" get gdzd color ,+6/4 valid gdzd>=1.and.gdzd<=spjl1
@3,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表导入数据起始行" get zd color ,+6/4 valid zd>=1.and.zd<=spjl1
@5,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表导入数据终止行" get mbjlh color ,+6/4 valid mbjlh>=1.and.mbjlh<=spjl1.and.mbjlh>=zd
@7,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表导入数据起始列" get gjzd1 color ,+6/4 valid gjzd1>=1.and.gjzd1<=spjl2
@9,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表导入数据终止列" get gjzd2 color ,+6/4 valid gjzd2>=1.and.gjzd2<=spjl2.and.gjzd2>=gjzd1
@11,7 say "Word第"+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"表数据的读取方式" get cdbh color ,+6/4 valid cdbh="手动".or.cdbh="自动"
set cursor on
read
set cursor off
release windows win1
endif
clear
if cdbh="自动".and.spk=1
if mbjlh=spjl1
*自动方式开始时，如当前表格取满行，则此后各表均取满行。
wasa="Y"
else
*自动方式开始时，如当前表格取部分行，则以后各表均取同样多的部分行。
wasa="N"
endif
spk=spk+1
endif
if cdbh="自动".and.spk=2
if gjzd2=spjl2
*自动方式开始时，如当前表格取满列，则此后各表均取满列。
lbzh="Y"
else
*自动方式开始时，如当前表格取部分列，则以后各表均取同样多的列。
lbzh="N"
endif
spk=spk+1
endif
if cdbh="自动"
if wasa="Y"
*直接取spjl1使用
else
if spjl1>mbjlh
spjl1=mbjlh
endif
endif
if lbzh="Y"
*直接取spjl2使用
else
if spjl2>gjzd2
spjl2=gjzd2
endif
endif
else
*手动方式
if spjl1>mbjlh
spjl1=mbjlh
endif
if spjl2>gjzd2
spjl2=gjzd2
endif
endif
use ls-ext
zap
sele 2
use lscfzk
sele 1
pk=gjzd1
jlcd1=(gdzd-1)*spjl2+(gjzd1-1)*spjl1-(gjzd1-1)*(zd-1)+1
store 0 to fac
store "" to name1
clear
wait clear
*快速构建库结构
if zljlh=6
jhh=spjl1
spjl1=gdzd
endif
*逐表逐列扫描单元格的内容宽度,不能直接取单元格宽度(数据折行时将被截断)
jdt=25
do while pk<=spjl2
*预取gdzd行之前各行各单元格的内容以利于取上合并单元格的字段名
jlsm=1
do while jlsm<gdzd
pp=alltrim(WordApp.Selection.Tables(1).CELL(jlsm,pk).Range.Text)
pp=alltrim(chrtranc(pp," ",""))
pp=alltrim(chrtranc(pp," ",""))
pp=left(pp,len(pp)-2)
if (.not.chr(2)$pp).and.(.not.""$pp).and.asc(pp)>=65.and.len(pp)>0.and.len(pp)<=10
name1(pk)=pp
endif
jlsm=jlsm+1
enddo
pk1=gdzd
do while pk1<=spjl1
gdhh=jlcd1*64.4/(spjl1*spjl2)+25
@12,25 say "正在扫描Word文档[&zdzs2.]第["+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"]表结构,进度："+ltrim(str(jlcd1*100/(spjl1*spjl2),10,2))+"%"
WordApp.Caption ="正在扫描[&zdzs2.]第["+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"]表的结构,进度："+ltrim(str(jlcd1*100/(spjl1*spjl2),10,2))+"%"
do while jdt<=gdhh
set color to +6/1
@13,jdt to 14,90 pen 2
jdt=jdt+0.1
set color to +7/1
enddo
jdt=jdt-0.1
if jlcd1/(spjl1*spjl2)=1
tdsj=inkey(0.1)
endif
*扫描每个表格每列的最大有效宽度，构建数据结构,此举明显影响数据导入速度。
pp=alltrim(WordApp.Selection.Tables(1).CELL(pk1,pk).Range.Text)
pp=alltrim(chrtranc(pp," ",""))
pp=alltrim(chrtranc(pp," ",""))
pp=left(pp,len(pp)-2)
pp1=0
*合并单元格的取值不正确,不作为字段宽度的侦测数据使用,以取值中含有chr(2)或""判定为合并格或行合并后的移尾格.
*首行单元格内容不超过10个字符且不重复，以字母、汉字打头，可自动取为字段名。
if (.not.chr(2)$pp).and.(.not.""$pp)
lin=pp
if pk1=gdzd
if len(lin)<=0.or.len(lin)>10
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")为空或超过10个字符，以[列地址]导入."
sele 1
else
jlsm=gjzd1
sdh=0
ybxh=1
do while jlsm<pk
if name1(jlsm)=lin
sdh=sdh+1
endif
if sdh<>0
*重复字段名切短后加角标
if len(alltrim(pp)+ltrim(str(ybxh)))<=10
lin=alltrim(pp)+ltrim(str(ybxh))
else
if asc(left(right(alltrim(pp),2),1))>127
lin=left(alltrim(pp),len(alltrim(pp))-2)+ltrim(str(ybxh))
else
lin=left(alltrim(pp),len(alltrim(pp))-1)+ltrim(str(ybxh))
endif
endif
if ybxh>=254
exit
endif
ybxh=ybxh+1
jlsm=gjzd1
sdh=0
loop
endif
jlsm=jlsm+1
enddo
if sdh=0
if asc(lin)>=65
name1(pk)=lin
else
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")非字母或汉字打头，以[列地址]导入."
sele 1
endif
else
name1(pk)=""
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")与前重复，以[列地址]导入."
sele 1
endif
endif
endif
pp1=alltrim(WordApp.Selection.Tables(1).CELL(pk1,pk).Range.Text)
pp1=len(alltrim(chrtranc(pp1," "," ")))
if pp1>fac(pk)
fac(pk)=pp1
if fac(pk)>254
exit
endif
endif
else
sele 2
append blank
if pk1=gdzd
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")为合并单元格，或以[列地址]导入."
else
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")为合并单元格，导入值可能有误."
endif
sele 1
wait "Word第["+ltrim(str(ydlh))+"]表cell("+ltrim(str(pk1))+","+ltrim(str(pk))+")为合并单元格，导入值可能有误。" at 18,25 window nowait
endif
*删除频繁使用内存变量以释放内存
*release pp
*release pp1
pk1=pk1+1
jlcd1=jlcd1+1
enddo
*release pk1
if zljlh=6
*快速库结构字宽直接取254
fac(pk)=254
endif
if pk<=26
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",pk),1)
else
if pk/26<>int(pk/26)
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",int(pk/26)),1)+right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",mod(pk,26)),1)
else
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",int(pk/26)-1),1)+"Z"
endif
endif
zxhd=zxhd+"_im"
append blank
replace field_name with zxhd
if trim(name1(pk))<>""
replace field_name with name1(pk)
endif
if fac(pk)<=254
if fac(pk)>0
replace field_type with "C"
replace field_len with fac(pk)
else
replace field_type with "C"
replace field_len with 10
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表第["+ltrim(str(pk))+"]宽度为0(以10字节替代)，数据导入可能有误."
sele 1
wait "Word第["+ltrim(str(ydlh))+"]表第["+ltrim(str(pk))+"]宽度为0(以10字节替代)，数据导入可能有误。" at 18,25 window nowait
endif
else
replace field_type with "M"
replace field_len with 4
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表第["+ltrim(str(pk))+"]列超宽，导入值可能有误."
sele 1
wait "Word第["+ltrim(str(ydlh))+"]表第["+ltrim(str(pk))+"]列超宽，导入值可能有误。" at 18,25 window nowait
endif
pk=pk+1
*release zxhd
enddo
*release pk
*release jlcd1
pk=reccount()
sele 2
use
sele 1
use
if pk>254.or.pk<=0
sele 2
use lscfzk
append blank
if pk>254
replace 导入错误 with "Word文档[&zdzs2.]第["+ltrim(str(ydlh))+"]表超过254列，放弃数据导入。"
else
replace 导入错误 with "Word文档[&zdzs2.]第["+ltrim(str(ydlh))+"]表未找到有效数据结构，放弃数据导入。"
endif
use
sele 1
ydlh=ydlh+1
loop
endif
xjkm2=zdzs2+ltrim(str(ydlh))
create &xjkm2 from ls-ext
sele 2
use lscfzk
sele 1
if zljlh=6
*还原快速库结构spjl1的值
spjl1=jhh
endif
*以下开始逐行导入数据,每行WORD表对应数据库一条记录.
pk=zd
jlcd1=(zd-1)*spjl2+(gjzd1-1)*spjl1-(gjzd1-1)*(zd-1)+1
clear
wait clear
jdt=25
*cdjl记录合并单元格前一行的值,实现列合并格同值导入.
store "" to cdjl
do while pk<=spjl1
append blank
dhfh=1
pk1=gjzd1
do while pk1<=spjl2
gdhh=jlcd1*64.4/(spjl1*spjl2)+25
@12,25 say "Word文档[&zdzs2.]第["+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"]表转为数据库，进度："+ltrim(str(jlcd1*100/(spjl1*spjl2),10,2))+"%"
do while jdt<=gdhh
set color to +6/1
@13,jdt to 14,90 pen 2
jdt=jdt+0.1
set color to +7/1
enddo
jdt=jdt-0.1
if jlcd1/(spjl1*spjl2)=1
tdsj=inkey(0.1)
endif
WordApp.Caption ="[&zdzs2.]第["+ltrim(str(ydlh))+"/"+ltrim(str(sttjh))+"]表转为数据库，进度："+ltrim(str(jlcd1*100/(spjl1*spjl2),10,2))+"%"
*WORD无法正确判定合并单元格,A1与A2列合并后,WORD将原来的第3列变为A2,而将空缺移到行尾,若是列合并,则将左上角以下的原有单元格认定为不存在.
pp1=alltrim(WordApp.Selection.Tables(1).CELL(pk,pk1).Range.Text)
pp1=alltrim(chrtranc(pp1," "," "))
*去掉单元格文本尾部的回车符
pp1=left(pp1,len(pp1)-2)
zdst=field(dhfh)
if (.not.chr(2)$pp1).and.(.not.""$pp1)
if pk<spjl1
*判定下一行是否为(列)合并单元格
czd1=alltrim(WordApp.Selection.Tables(1).CELL(pk+1,pk1).Range.Text)
czd1=alltrim(chrtranc(czd1," "," "))
*去掉单元格文本尾部的回车符
czd1=left(czd1,len(czd1)-2)
*如果下一行是列合并单元格,保留当前列当前行的值.
if chr(2)$czd1.or.""$czd1
cdjl(pk1)=pp1
else
cdjl(pk1)=""
endif
*判定下一行移尾的合并单元格个数
szpk=sjxsw
czd2=alltrim(WordApp.Selection.Tables(1).CELL(pk+1,szpk).Range.Text)
czd2=alltrim(chrtranc(czd2," "," "))
*去掉单元格文本尾部的回车符
czd2=left(czd2,len(czd2)-2)
do while (chr(2)$czd2.or.""$czd2).and.szpk>1
*如果下一行存在行合并移尾单元格,则清空相应列的cdjl值.
cdjl(szpk)=""
szpk=szpk-1
czd2=alltrim(WordApp.Selection.Tables(1).CELL(pk+1,szpk).Range.Text)
czd2=alltrim(chrtranc(czd2," "," "))
*去掉单元格文本尾部的回车符
czd2=left(czd2,len(czd2)-2)
enddo
endif
replace &zdst with pp1
if alltrim(pp1)<>alltrim(&zdst)
sele 2
append blank
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表Cell("+ltrim(str(pk))+","+ltrim(str(pk1))+")导入值与原值不同."
sele 1
endif
else
replace &zdst with cdjl(pk1)
if alltrim(pp1)<>alltrim(&zdst)
sele 2
append blank
if pk1=spjl2
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表Cell("+ltrim(str(pk))+","+ltrim(str(pk1))+")导入值可能有误(行合并移尾格)."
else
replace 导入错误 with "["+zdzs2+"]文档第["+ltrim(str(ydlh))+"]表Cell("+ltrim(str(pk))+","+ltrim(str(pk1))+")导入值可能有误(行或列合并格)."
endif
sele 1
endif
endif
*删除频繁使用内存变量以释放内存
*release pp1
*release zdst
pk1=pk1+1
jlcd1=jlcd1+1
dhfh=dhfh+1
enddo
*release pk1
pk=pk+1
cxhh=cxhh+1
enddo
*release pk
if zljlh=6
*整理快速导入的库结构
store 0 to rec1
pk=1
do while pk<=fcount()
go top
do while .not.eof()
zjdh=field(pk)
if len(alltrim(&zjdh))>rec1(pk)
rec1(pk)=len(alltrim(&zjdh))
endif
skip
enddo
pk=pk+1
enddo
copy to ext-bj structure extended
use ext-bj
pk=1
do while pk<=reccount()
go pk
replace field_len with rec1(pk)+2
pk=pk+1
enddo
use
create ls-xt from ext-bj
append from &xjkm2
copy to &xjkm2
use &xjkm2
endif
*切除最后一列（辅助列）
jhh=fields(fcount())
alter table &xjkm2 drop column &jhh
if sttjh>1
*修改导入库的字段名、字段类型和字段宽度，加入汇总库。
copy to lszjk
use lszjk
=afields(jgfh)
pk=1
pk1=fcount()
if ydlh=1
amb=fcount()
endif
do while pk<=pk1
if pk<=26
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",pk),1)
else
if pk/26<>int(pk/26)
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",int(pk/26)),1)+right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",mod(pk,26)),1)
else
zxhd=right(left("ABCDEFGHIJKLMNOPQRSTUVWXYZ",int(pk/26)-1),1)+"Z"
endif
endif
zxhd=zxhd+"_im"
if upper(jgfh(pk,1))<>upper(zxhd)
zxhd1=jgfh(pk,1)
alter table lszjk rename column &zxhd1 to &zxhd
endif
if ydlh>1.and.pk<=pk1.and.pk<=amb
if jgfh(pk,3)>xsw(pk,3)
*导入的数据只有C和M两种类型
zxhd1=xsw(pk,1)
zxhd2=jgfh(pk,3)
if jgfh(pk,2)="C".and.xsw(pk,2)="C"
alter table wd汇总 alter column &zxhd1 C(zxhd2)
else
alter table wd汇总 alter column &zxhd1 M(4)
endif
sele 3
use
sele 1
endif
endif
pk=pk+1
enddo
if ydlh=1
copy to wd汇总
use wd汇总
alter table wd汇总 add column 表序号 N(10)
replace all 表序号 with ydlh for 表序号=0
amb=fcount()
=afields(xsw)
else
use wd汇总
if pk1>=fcount()
copy to ls-xt
use lszjk
copy structure to wd汇总
use wd汇总
alter table wd汇总 add column 表序号 N(10)
append from ls-xt
endif
append from lszjk
replace all 表序号 with ydlh for 表序号=0
amb=fcount()
=afields(xsw)
endif
endif
use
sele 2
use
sele 1
ydlh=ydlh+1
ENDDO
WordApp.ActiveWindow.Close(.F.)
*WordApp.Quit
*release WordApp
clear
wait clear
create table lsgdk (导入内容 C(254))
if ydlh>1.and.cxhh>1
pk=1
do while pk<=ydlh
*数据库文件名过长以相同内容的拷贝库在DBFLIST中注册
if pk<ydlh
xjkm2=zdzs2+ltrim(str(pk))+".dbf"
else
xjkm2="wd汇总.dbf"
endif
if file(xjkm2)
if xjkm2<>"wd汇总.dbf"
use &xjkm2
set console off
list to ls.txt off
set console on
*将多个表格的导入数据存放到中间数据库，再转到repttt.txt中。
use lsgdk
append from ls.txt sdf
use
endif
use &xjkm2
if pk<ydlh
wait "以下是从["+zdzs2+"]文档第["+ltrim(str(pk))+"]表导入的数据。" at 16,51 window nowait
else
wait "以下是从["+zdzs2+"]文档各表导入的汇总数据。" at 16,51 window nowait
endif
brow
use
endif
*只有一个表格时没有汇总库
if pk=1.and.sttjh=1
exit
endif
pk=pk+1
enddo
wait clear
use lsgdk
set console off
list to repttt.txt field trim(导入内容) off
set console on
use
else
wait clear
messagebox("Word文档[&zdzs2.]中未找到待导入的数据。",48,"导入Word数据")
endif
use lscfzk
if .not.eof()
wait "以下是记录在LSCFZK库中的数据导入错误信息" at 16,42 window nowait
brow
endif
use
if cxhh>1
wait "全C型导入,同步另存于repttt.txt" at 16,50 window nowait
tdsj=inkey(1)
endif
else
wait "Word文档[&zdzs2.]不存在" at 16,50 window nowait
endif
else
wait "放弃Word表格导入操作" at 16,50 window nowait
endif
erase ls-ext.dbf
erase ls-ext.fpt
erase lsgdk.dbf
erase lsgdk.fpt
erase lszjk.dbf
erase lszjk.fpt
erase ls-xt.dbf
erase ls-xt.fpt
erase ext-bj.dbf
erase ext-bj.fpt
use &gdkm
return
