作者在 2010-09-21 14:37:25 发布以下内容
与大家分享一个由EXECL导入DBF的程序,这是根据hu9jj老师给我的例子再加上在网上查的,经过实际应用自己改编的。希望能对各位有点帮助。
*******建立一个excel对象*******
LOCAL mypath,hb1 as excel.application
SET SAFETY OFF
thisform.olecontrol2.Panels(2).Text =""
thisform.olecontrol2.Panels(1).Text =""
mypath=""
mypath=getfile("xls")
***读取数据源所在的EXCEL文件名****
IF EMPTY(TRIM(mypath))
MESSAGEBOX("请先选择要导入的excel文件!",0,"提示")
RETURN
ELSE
thisform.olecontrol2.Panels(1).Text =LOCFILE(mypath)
ENDIF
try
hb1=createobject("excel.application")
catch
messagebox("请检查你是否已安装microsoft excel应用程序!",0,"提示")
endtry
LOCAL mypath,hb1 as excel.application
SET SAFETY OFF
thisform.olecontrol2.Panels(2).Text =""
thisform.olecontrol2.Panels(1).Text =""
mypath=""
mypath=getfile("xls")
***读取数据源所在的EXCEL文件名****
IF EMPTY(TRIM(mypath))
MESSAGEBOX("请先选择要导入的excel文件!",0,"提示")
RETURN
ELSE
thisform.olecontrol2.Panels(1).Text =LOCFILE(mypath)
ENDIF
try
hb1=createobject("excel.application")
catch
messagebox("请检查你是否已安装microsoft excel应用程序!",0,"提示")
endtry
***打开EXCEL对象,开始读取数据********
HB1.workbooks.open(TRIM(mypath))
HB1.workbooks.open(TRIM(mypath))
hb1.Sheets("Sheet1").select
sele ry_temp
ZAP
bh=hb1.Cells(1,1).Value
IF ALLTRIM(bh)#"单位编号"
MessageBox("数据错误:EXCEL工作表SHeet1的第一行首列必须是[单位编号]!",48,"EXCEL数据格式错误,导入数据失败!")
exit
ELSE
i=2
DO WHILE .t. &&预先计算记录数量
bh = hb1.CELLS(i,1).value
IF isnull(bh) &&判断有没有空行,有则退出
EXIT
ENDIF
i=i+1
ENDDO
thisform.label1.Caption ="共有"+ALLTRIM(STR(i-2))+"行数据,开始导入数据,请稍候..."
thisform.label1.refresh
sjds=ALLTRIM(STR(i-2))
ENDIF
i=2
DO WHILE .t.
bh=hb1.Cells(i,1).Value
**用于判断数据类型,数据类型一定要判断是否为NULL,**
** 然后如果不是指定的类型,还要进行转换*************
IF ISNULL(bh)
exit
endif
IF VARTYPE(bh)='N'
bh=ALLTRIM(STR(bh,9))
endif
ZAP
bh=hb1.Cells(1,1).Value
IF ALLTRIM(bh)#"单位编号"
MessageBox("数据错误:EXCEL工作表SHeet1的第一行首列必须是[单位编号]!",48,"EXCEL数据格式错误,导入数据失败!")
exit
ELSE
i=2
DO WHILE .t. &&预先计算记录数量
bh = hb1.CELLS(i,1).value
IF isnull(bh) &&判断有没有空行,有则退出
EXIT
ENDIF
i=i+1
ENDDO
thisform.label1.Caption ="共有"+ALLTRIM(STR(i-2))+"行数据,开始导入数据,请稍候..."
thisform.label1.refresh
sjds=ALLTRIM(STR(i-2))
ENDIF
i=2
DO WHILE .t.
bh=hb1.Cells(i,1).Value
**用于判断数据类型,数据类型一定要判断是否为NULL,**
** 然后如果不是指定的类型,还要进行转换*************
IF ISNULL(bh)
exit
endif
IF VARTYPE(bh)='N'
bh=ALLTRIM(STR(bh,9))
endif
mc=ALLTRIM(hb1.Cells(i,2).Value)
xm=ALLTRIM(hb1.Cells(i,3).Value)
sfz=hb1.Cells(i,4).Value
IF VARTYPE(sfz)='N'
sfz=ALLTRIM(STR(sfz,18))
ENDIF
* IF ISNULL(sfz)
* sfz=""
* ENDIF
* SET PROCEDURE TO &Mymllj.\Prg\sfzhm.prg ADDITIVE &&打开过程文件
* IF sfzhm(sfz)=.t. &&调用身份证验证程序,验证通过则开始导入
* thisform.olecontrol1.Visible=.t.
* ELSE
* MessageBox("身份证号有错误!请检查",48,"导入数据失败!")
* thisform.olecontrol1.Visible=.f.
* thisform.label1.Caption=""
* EXIT &&不正确则中断导入
*endif
rxb=ALLTRIM(hb1.Cells(i,5).Value)
rnl=hb1.Cells(i,6).Value
IF VARTYPE(rnl)='N'
rnl=ALLTRIM(STR(rnl))
ENDIF
xz=lower(ALLTRIM(hb1.Cells(i,7).Value))
nd=hb1.Cells(i,8).Value
IF VARTYPE(nd)='N'
nd=alltrim(STR(nd))
endif
zz=ALLTRIM(hb1.Cells(i,9).Value)
IF ISNULL(zz)
zz=""
ENDIF
dh=hb1.Cells(i,10).Value
IF VARTYPE(dh)='N'
dh=ALLTRIM(STR(dh,11))
ENDIF
IF ISNULL(dh)
dh=""
ENDIF
xm=ALLTRIM(hb1.Cells(i,3).Value)
sfz=hb1.Cells(i,4).Value
IF VARTYPE(sfz)='N'
sfz=ALLTRIM(STR(sfz,18))
ENDIF
* IF ISNULL(sfz)
* sfz=""
* ENDIF
* SET PROCEDURE TO &Mymllj.\Prg\sfzhm.prg ADDITIVE &&打开过程文件
* IF sfzhm(sfz)=.t. &&调用身份证验证程序,验证通过则开始导入
* thisform.olecontrol1.Visible=.t.
* ELSE
* MessageBox("身份证号有错误!请检查",48,"导入数据失败!")
* thisform.olecontrol1.Visible=.f.
* thisform.label1.Caption=""
* EXIT &&不正确则中断导入
*endif
rxb=ALLTRIM(hb1.Cells(i,5).Value)
rnl=hb1.Cells(i,6).Value
IF VARTYPE(rnl)='N'
rnl=ALLTRIM(STR(rnl))
ENDIF
xz=lower(ALLTRIM(hb1.Cells(i,7).Value))
nd=hb1.Cells(i,8).Value
IF VARTYPE(nd)='N'
nd=alltrim(STR(nd))
endif
zz=ALLTRIM(hb1.Cells(i,9).Value)
IF ISNULL(zz)
zz=""
ENDIF
dh=hb1.Cells(i,10).Value
IF VARTYPE(dh)='N'
dh=ALLTRIM(STR(dh,11))
ENDIF
IF ISNULL(dh)
dh=""
ENDIF
sele ry_temp &&这是要读取的数据存放的表
APPEND BLANK
***INSERT INTO ry_temp (dwbh,dwmc,ryxm,sfzh,xb,nl,xzdm,cbnd,jzd,lxdh,ybbh,ryxz,cbzt,jsnd,ryjdbh,csrq,sfbz,bz)VALUES(bh,mc,xm,sfz,rxb,rnl,xz,nd,zz,dh,"","","","","","","","")
REPLACE dwbh WITH bh,dwmc WITH mc,ryxm WITH xm,sfzh WITH sfz,xb WITH rxb,nl WITH rnl,xzdm WITH xz,cbnd WITH nd,jzd WITH zz,lxdh WITH dh
i=i+1
&&如果一行全为空,记作记录到底****
IF EMPTY(bh) AND EMPTY(mc) AND EMPTY(xm) AND EMPTY(sfz) AND EMPTY(xz)
exit
ENDIF
ENDdo
thisform.olecontrol1.Visible=.t.
for a=1 to 1000
for j=1 to 2000
j=j+1
endfor
thisform.olecontrol1.value=a
a=a+1
endfor
messagebox("共转换导入"+ALLTRIM(STR(RECCOUNT()))+"条记录,"+CHR(13)+"请查明是否正确!",0+64,"数据导入完成!")
thisform.olecontrol1.Visible=.f.
thisform.label1.Caption=""
thisform.olecontrol2.Panels(2).Text ="共有"+sjds+"行数据"+SPACE(5)+"导入"+ALLTRIM(STR(RECCOUNT()))+"条记录"
hb1.ActiveWorkbook.Save
hb1.Workbooks.close &&关闭文件并退出EXCEL
hb1.quit
RELEASE hb1 &&释放变量
APPEND BLANK
***INSERT INTO ry_temp (dwbh,dwmc,ryxm,sfzh,xb,nl,xzdm,cbnd,jzd,lxdh,ybbh,ryxz,cbzt,jsnd,ryjdbh,csrq,sfbz,bz)VALUES(bh,mc,xm,sfz,rxb,rnl,xz,nd,zz,dh,"","","","","","","","")
REPLACE dwbh WITH bh,dwmc WITH mc,ryxm WITH xm,sfzh WITH sfz,xb WITH rxb,nl WITH rnl,xzdm WITH xz,cbnd WITH nd,jzd WITH zz,lxdh WITH dh
i=i+1
&&如果一行全为空,记作记录到底****
IF EMPTY(bh) AND EMPTY(mc) AND EMPTY(xm) AND EMPTY(sfz) AND EMPTY(xz)
exit
ENDIF
ENDdo
thisform.olecontrol1.Visible=.t.
for a=1 to 1000
for j=1 to 2000
j=j+1
endfor
thisform.olecontrol1.value=a
a=a+1
endfor
messagebox("共转换导入"+ALLTRIM(STR(RECCOUNT()))+"条记录,"+CHR(13)+"请查明是否正确!",0+64,"数据导入完成!")
thisform.olecontrol1.Visible=.f.
thisform.label1.Caption=""
thisform.olecontrol2.Panels(2).Text ="共有"+sjds+"行数据"+SPACE(5)+"导入"+ALLTRIM(STR(RECCOUNT()))+"条记录"
hb1.ActiveWorkbook.Save
hb1.Workbooks.close &&关闭文件并退出EXCEL
hb1.quit
RELEASE hb1 &&释放变量
就是不知怎样加上一个身份证号真假的验证程序。如果有谁能加上,麻烦告诉我一声,谢谢。