|
YEAR=ltrim(rtrim(str(thisform.yymm1.spinner2.value,4,0))) mon1=ltrim(rtrim(str(thisform.yymm1.Spinner1.value,2,0))) IF len(mon1)=1 mon="0"+mon1 ELSE mon=mon1 ENDIF dwx2="&year"+"&mon" pcsys=sys(5)+sys(2003) pcsys1='&pcsys'+'\'+'hfdata\'+'&dwx2'+'\' cDir=GETDIR('hdhf')+'*.*' wait wind "请稍候！" nowait if cdir=" " then retu endif *cDir=GETDIR() nCount=ADIR(cFile,cDir,"D") asd=len(cdir) asd1=substr(cdir,1,asd-3) x=1 cdir3='&pcsys1'+ '&dwx2'+alltrim(str(x))+'.xls' if .not. file("&cdir3") MkDir 'hfdata\'+'&dwx2' FOR i=1 TO nCount IF "D"$cfile(i,5) AND !cfile(i,1)=="." AND !cfile(i,1)==".." cdir1=asd1+ cfile(i,1)+'\*.xls' Ccdir1=adir(xx , '&cdir1') IF ccdir1<> 0 then cdir3='&pcsys1'+ '&dwx2'+alltrim(str(x))+'.xls' COPY file '&cdir1' to '&cdir3' x=x+1 else nanswer= Messagebox('选择的源文件目录错误，请另选择......',1,'信息提示') rmdir 'hfdata\'+'&dwx2' retu 0 endif ENDIF ENDFOR else nanswer= Messagebox('&dwx2'+'份话费数据已经存在，是否继续...',1,'信息提示') do case case nanswer = 1 FOR i=1 TO nCount IF "D"$cfile(i,5) AND !cfile(i,1)=="." AND !cfile(i,1)==".." cdir1=asd1+ cfile(i,1)+'\*.xls' cdir3='&pcsys1'+ '&dwx2'+alltrim(str(x))+'.xls' Ccdir1=adir(xx , '&cdir1') IF ccdir1<> 0 then cdir3='&pcsys1'+ '&dwx2'+alltrim(str(x))+'.xls' COPY file '&cdir1' to '&cdir3' x=x+1 else nanswer= Messagebox('选择的源文件目录错误，请另选择......',1,'信息提示') retu 0 endif ENDIF ENDFOR *Messagebox('&dwx2'+'份话费数据文件已经覆盖...',64,'信息提示') case nanswer = 2 retu 0 endcase endif for zhsl=1 to x-1 mjmc='&pcsys1'+ '&dwx2'+ltrim(str(zhsl))+".xls" fil=mjmc oExcel=Createobject('Excel.application') oExcel.Workbooks.Open(fil) &&打开文件 oExcel.Selection.AutoFilter &&关闭(如果无则打开)自动筛选 *oExcel.Range("A1:F1000").Select &&选中从第1行到1000行的前6列数据(另存后只有这些数据) *cdir2='&gcdirhfdata'+'&dwx2'+'\' asfil=Strtran(Upper(Strtran(fil,Substr(fil,1,Rat('\',fil)),'&pcsys1')),'.XLS','.dbf') &&要保存的文件名 * asfil If File(asfil) Delete File &asfil Endif oExcel.ActiveWorkbook.SaveAs(asfil,8) &&另存为DBF oExcel.ActiveWorkbook.saved=.T. &&不保存当前EXCEL表 oExcel.Workbooks.Close &&关闭表 oExcel.Quit &&退出EXCEL Release oExcel &&释放变量 *messagebox('Excel文件:D:\TEST.XLS 另存为 D:\TEST.DBF 完成！',64,'信息提示') *Messagebox('数据文件第'+ltrim(str(zhsl))+'账号另存为 '+'&asfil'+' 完成！',64,'信息提示') next *clear *use data\temp.dbf in 0 alias temp1 asd= 'hfdata\'+'&dwx2'+'\'+ '&dwx2'+'.dbf' if .not. file("&asd") create 'hfdata\'+'&dwx2'+'\'+ '&dwx2'from data\hftemp else IF !USED('hfsj') USE ('&pcsys1'+ '&dwx2') IN 0 alias hfsj EXCLUSIVE ENDIF *use 'hfdata\'+'&dwx2'+'\'+ '&dwx2' in 0 alias hfsj EXCLUSIVE sele hfsj zap endif *use 'hfdata\'+'&dwx2'+'\'+ '&dwx2' in 0 alias hfsj for zhsl=1 to x-1 sjmjmc='hfdata\'+'&dwx2'+'\'+ '&dwx2' +ltrim(str(zhsl))+".dbf" *use D:\tx\11111 appe from '&sjmjmc' next use wait wind "原始数据转换结束，谢谢！" nowait thisform.release retu |
|
|
