好象也不是完全是路径,用本人的VFP生成的EXCEL表能导入,如人家的EXCEL表有的能导入有的就出现上述的提示。好象是EXCEL表版本及表中的格式有关,所以在代码开始处提出要求
附上代码,请各位斧正:
yy=MESSAGEBOX("你是否符合下列要求吗?"+chr(13)+"1.在D盘下新建一个目录."+CHR(13)+"2.把『相同结构的Excel表』放在新建目录中."+chr(13)+"3.去掉表的顶端标题行,合适的列宽,行高,取消各种修鉓(如合并单元格等等)及计算公式,"+CHR(13)+" 字段名内不能有空格与标点符号."+CHR(13)+"4.最后把Excel表另存为:Microsoft Excel 5.0/95格式!",4+48+0,'注意以下的提醒!')
IF yy=6
cdir=GETDIR("d:","请选择存放相同结构的Excel表的目录")
*CD (cdir) &&进入相应的目录
IF EMPTY(cdir) &&判断有否选择要导入Excel表的目录
MESSAGEBOX("请选择待导入的EXCEL文档的目录!",0+48,"提示")
RETURN
ELSE
cdir=left(cdir,len(cdir)-1)
cd (cdir)
delete file todata.dbf
lnFiles=Adir(aFile,"*.xls")
**VFP 中用代码从EXCEL中导向DBF**
eole=CREATEOBJECT('Excel.application') &&创建COM连接
eole.DisplayAlerts = .f. &&不要产生警告提示
eole.Workbooks.open(cdir+"\"+aFile(1,1)) && 这里取绝对路径
eole.Worksheets[1].Activate &&这里用表名就是类似SHEET1 什么的
eole.visible=.f. && 隐藏EXCEL进程,另读取数据都在后台进行
eole.ActiveWorkbook.SaveAs(cdir+"\"+"dbfname.dbf",8) &&DBASE3格式为8,11为dbf4
*eole.ActiveWorkbook.SaveAs(".\"+"dbfname.dbf",8)
eole.ActiveWorkbook.saved=.t. &&不显示保存对话框
eole.save &&保存
eole.Quit &&退出
RELEASE eole &&释放
*use aFile(1,1)
use dbfname.dbf
copy Structure To todata
use todata
For lnI=1 To lnFiles
lcStr=(aFile(lnI,1))
*wait "正在转换!请稍候.....已转换"+lcstr windows TIMEOUT 1 nowait
*WAIT "正在转换 "+lcstr WINDOW TIMEOUT 0 NOWAIT AT SROWS()/2,(SCOLS()-LEN("正在转换 "+lcstr))/2
**捕捉错误1**
err1=.f.
On error err1=.t.
Append From '&lcStr.' type XL5 && SHEET JUSTSTEM(lcstr)表示哪一个工作表,缺省为第一个工作表,&&xl5为excel 5.0/95版, xls 为excel 2.版,xl8 为97版
on error
if err1
nvalue=MESSAGEBOX('Excel电子表版本不附合转化要求,应是Microsoft Excel 5.0/95格式!,请退出检查!',0+48,"提醒!")
IF nvalue=1
retu
Endif
endif
**以上为捕捉错误1结束**
wait "正在转换!请稍候.....已转换:"+lcstr windows TIMEOUT 1 nowait
Endfor
inde on EVALUATE(FIELD(1)) to ls
go bott
brow
**捕捉错误2**
err2=.f.
On error er2r=.t.
If ALLTRIM(EVALUATE(FIELD(1)))=ALLTRIM(LOWER(FIELD(1))).OR.ALLTRIM(EVALUATE(FIELD(1)))=ALLTRIM(UPPER(FIELD(1))) &&字段1==字段1的值(小写变大写)
**加上语旬
Dele all for ALLTRIM(EVALUATE(FIELD(1)))=ALLTRIM(LOWER(FIELD(1))).OR.ALLTRIM(EVALUATE(FIELD(1)))=ALLTRIM(UPPER(FIELD(1)))
on error
if err2
wait wind 'Excel表的第一个字段的字段值有问题,请退出检查!'
retu
endif
**以上为捕捉错误288结束
Pack
ELSE
RETU
ENDIF &&字段1==字段1的值(小写变大写)判断结束
=MESSAGEBOX("转化、合并完毕!,生成名为:TOTDATA数据库,并请检查库的内容!",0+48,"提醒:转化合并完毕")
ENDIF &&判断有否选择要导入Excel表的目录结束
ELSE &&不附合转化要求即退出
retu
ENDIF &&判断导入表有否附合要求与if yy=6对应 结束
CLOSE ALL
DELETE FILE dbfname.dbf
DELETE FILE *.idx
set talk on
SET SAFE ON