与大家分享一个由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 &&释放变量




就是不知怎样加上一个身份证号真假的验证程序。如果有谁能加上，麻烦告诉我一声，谢谢。

挺好。提问者变成指导者，也是一个进步。
身份证验证代码，本论坛貌似有那样的主题，楼主可以搜索一番。

谢谢Tiger5392老师

支持！

[ 本帖最后由 hu9jj 于 2010-9-23 08:50 编辑 ]

以下是根据网上的相关资料写的一段校验身份证号码的代码，把它作为一个自定义函数，希望对你有用。
PARAMETERS sfzh
ZH=LEFT(sfzh,17)
JYM0=SUBSTR(sfzh,18,1)
R1=0
FOR I=17 TO 1 STEP -1
  R1=R1+ VAL(SUBSTR(ZH,18-I,1)) * 2^(I-1)%11 &&计算校验码
NEXT
R1=R1%11
Jym=IIF(R1=0,"1", IIF(R1=1,"X", IIF(R1=2,"8",IIF(R1=3,"6", IIF(R1=4,"4",;
IIF(R1=5,"2",IIF(R1=6,"0", IIF(R1=7,"9", IIF(R1=8,"7", IIF(R1=9,"5","3"))))))))))
RETURN "身份证的校验码是："+jym0+"  计算的校验码是："+jym+" 身份证号码"+IIF(jym0=jym,"正确","错误")

* 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
我的程序中这段代码加了个身份证验证，用的是十三豆老师的，但在运行时，出现错误提示。身份证正确，也提示有错。我贴下这段代码，里边有我自己加的提示，不知是不是加的不正确原故：
*----------------------------------------------------
*此函数功能：检验输入的15位或18位身份证号码是否为合法
*----------------------------------------------------
Function sfzhm &&校验身份证号是否合法
    Lparameters lstr &&参数:lstr 传入的号码
    Private lstr,relyn,tsfz,m1,m2,m3,m4,m,I,r,c,ai,wi
    relyn=.F. &&返回值
    tsfz=Alltrim(lstr)
    *分别用m1,m2,m3,m4表示四个条件是否成立
    Stor .T. To m1,m2,m3,m4
    *条件1：只能是15或18位
    m1=Iif(Len(tsfz)=15 Or Len(tsfz)=18,.T.,.F.)
    If Len(tsfz)=15 && 15位的号码
        For I=1 To 15 &&检查每一位是否为数字
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57 &&数字
                m2=.F. &&若有一位不是就不再查
                MessageBox("身份证号有一位不是数字！请检查",48,"医保系统！")
                Exit
            Endif
        Endfor
        m="19" +Substr(tsfz, 7,2) &&早期的号都是上个世纪的
        m=m+"."+Substr(tsfz, 9,2)
        m=m+"."+Substr(tsfz,11,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F. &&生日不正确
         MessageBox("身份证生日不正确！请检查",48,"医保系统！")   
        Endif
    Endif
    If Len(tsfz)=18 && 18位的号码
        For I=1 To 17
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57
                m2=.F.
                MessageBox("身份证号有一位不是数字！请检查",48,"医保系统！")
                Exit
            Endif
        Endfor
        m=Substr(tsfz,7,4)
        m=m+"."+Substr(tsfz,11,2)
        m=m+"."+Substr(tsfz,13,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F.
            MessageBox("身份证号生日不正确！请检查",48,"医保系统！")
        Endif
        r=0 &&计算校验位
        For I=18 To 2 Step -1
            ai=Val(Substr(tsfz,19-i,1))
            wi=Mod(2^(i-1),11)
            r=r+ai*wi
        Next
        r=Mod(r,11)
        Do Case
            Case r=0
                c="1"
            Case r=1
                c="0"
            Case r=2
                c="X"
            Otherwise
                c=Alltrim(Str(12-r))
        Endcase
        If Upper(Substr(tsfz,18,1))<>c
            m4=.F. &&校验位与原码最末位不同
          MessageBox("身份证号校验位与原码最末位不同！请检查",48,"医保系统！")   
        Endif
    Endif
    *四个条件全成立，则返回.t.
    relyn=Iif(m1 And m2 And m3 And m4,.T.,.F.)
    Return relyn
Endfunc

*----------------------------------------------------
*此函数功能：检验输入的15位或18位身份证号码是否为合法
*----------------------------------------------------
Function sfzhm &&校验身份证号是否合法
    Lparameters lstr &&参数:lstr 传入的号码
    Private lstr,relyn,tsfz,m1,m2,m3,m4,m,I,r,c,ai,wi
    relyn=.F. &&返回值
    tsfz=Alltrim(lstr)
    *分别用m1,m2,m3,m4表示四个条件是否成立
    Stor .T. To m1,m2,m3,m4
    *条件1：只能是15或18位
    m1=Iif(Len(tsfz)=15 Or Len(tsfz)=18,.T.,.F.)
    If Len(tsfz)=15 && 15位的号码
        For I=1 To 15 &&检查每一位是否为数字
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57 &&数字
                m2=.F. &&若有一位不是就不再查
                MessageBox("身份证号有一位不是数字！请检查",48,"医保系统！")
                Exit
            Endif
        Endfor
        m="19" +Substr(tsfz, 7,2) &&早期的号都是上个世纪的
        m=m+"."+Substr(tsfz, 9,2)
        m=m+"."+Substr(tsfz,11,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F. &&生日不正确
         MessageBox("身份证生日不正确！请检查",48,"医保系统！")   
        Endif
    Endif
    If Len(tsfz)=18 && 18位的号码
        For I=1 To 17
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57
                m2=.F.
                MessageBox("身份证号有一位不是数字！请检查",48,"医保系统！")
                Exit
            Endif
        Endfor
        m=Substr(tsfz,7,4)
        m=m+"."+Substr(tsfz,11,2)
        m=m+"."+Substr(tsfz,13,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F.
            MessageBox("身份证号生日不正确！请检查",48,"医保系统！")
        Endif
        r=0 &&计算校验位
        For I=18 To 2 Step -1
            ai=Val(Substr(tsfz,19-i,1))
            wi=Mod(2^(i-1),11)
            r=r+ai*wi
        Next
        r=Mod(r,11)
        Do Case
            Case r=0
                c="1"
            Case r=1
                c="0"
            Case r=2
                c="X"
            Otherwise
                c=Alltrim(Str(12-r))
        Endcase
        If Upper(Substr(tsfz,18,1))<>c
            m4=.F. &&校验位与原码最末位不同
          MessageBox("身份证号校验位与原码最末位不同！请检查",48,"医保系统！")   
        Endif
    Endif
    *四个条件全成立，则返回.t.
    relyn=Iif(m1 And m2 And m3 And m4,.T.,.F.)
    Return relyn
Endfunc
我的这个程序改动有误吗？在我的程序调用是否得当？请老师给看看。