分享一个EXECL导入DBF的小程序

作者在 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
***打开EXCEL对象,开始读取数据********
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
  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
 
 
  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 &&释放变量
 
 
 
 
就是不知怎样加上一个身份证号真假的验证程序。如果有谁能加上,麻烦告诉我一声,谢谢。
默认分类 | 阅读 799 次
文章评论,共0条
游客请输入验证码
文章分类
文章归档
最新评论