导出EXCEL/FOXPRO/PRODOX格式表

核心提示：一般是在access或是SQLSERVER中查寻，或是汇总，导出EXCEL/FOXPRO/PRODOX格式表，然后生成一个‘记录集’可以显示在GRID里，也可以将这个记录集导出到磁盘中，并还原.myStr=StrReverse(Left(myStr,myPos-1))'取文件名Export_Str="

一般是在access或是SQLSERVER中查寻，或是汇总，然后生成一个‘记录集’可以显示在GRID里，也可以将这个记录集导出到磁盘中。　　

下面可以导出Xls,DBF,DB,MDB(表）,这些功能是由ISAM数据库接口实现，为了导出各种版本的文件，我在MS网站下载了最新的JET4和MDAC6。前者到用于桌面数据库如ACCESS，FOXPRO的组件，后者是实现新版本ADO组件。分别在：

http://download.microsoft.com/download/access2000/SP/4.0/NT5/EN-US/Jet40SP5_W2K.exe
　　http://download.microsoft.com/download/dasdk/install/2.60.6526.3/WIN98Me/CN/mdac_typ.exe

这些是标准的SQL导出语句：

select*into[office/9.shtml'target='_blank'class='article'>Excel8.0;database=导出目录].导出表名from表

select*into[FoxPro2.6;database=导出目录].导出表名from表

select*into[FoxPro2.5;database=同上].导出表名from表

select*into[dBaseIII;database=同上].导出表名from表

select*into[Paradox4.X;database=同上].导出表名from表

select*into[;database=C:\temp\xxx.mdb].导出表名from表

下面程序为实现用户自定议文件名用变量代替一部分。

http://go.163.com/~chunpeng/project/export.jpg

http://go.163.com/~chunpeng/project/Export.zip点这里下载原程序文件。　　

'请先引用ADODB类库。

DimExport_Str,mdbTableAsString

DimrsExportAsNewADODB.Recordset

DimconnAsNewADODB.Connection

PrivateSubClose_cmd_Click()

UnloadMe

EndSub

PrivateSubEXport_cmd_Click()

DimmyPath,myStrAsString,myPosAsInteger

'******************处理选择的各种表的导出

WithDialog1

IfmyOption(2).ValueThen

.FilterIndex=1

.ShowSave

myStr=StrReverse(.FileName)'串取反

myPos=InStr(myStr,"\")'在反字符串中，找从左开始第一个\的位置

OnErrorGoTomyError'防FILENAME为空，MID出错

myPath=StrReverse(Mid(myStr,myPos))'取目录部分，并还原.

myStr=StrReverse(Left(myStr,myPos-1))'取文件名

Export_Str="select*into[dBaseIII;database="&myPath&"]."&myStr&"fromCustomers"

.DefaultExt="*.DBF"
　　

ElseIfmyOption(3).ValueThen

mdbTable=InputBox("请给导出到MDB文件的表确定表名")

.FilterIndex=2

.ShowSave

Export_Str="select*into[;database="&.FileName&"]."&mdbTable&"fromCustomers"

.DefaultExt="*.MDB"　

ElseIfmyOption(4).ValueThen

.FilterIndex=3

.ShowSave

Export_Str="select*into[Excel8.0;database="&.FileName&"].CustomersfromCustomers"

.DefaultExt="*.XLS"　　

ElseIfmyOption(5).ValueThen

.FilterIndex=4

.ShowSave

myStr=StrReverse(.FileName)'串取反

myPos=InStr(myStr,"\")'在反字符串中，找从左开始第一个\的位置

OnErrorGoTomyError'防FILENAME为空，MID出错

myPath=StrReverse(Mid(myStr,myPos))'取目录部分，并还原.

myStr=StrReverse(Left(myStr,myPos-1))'取文件名

Export_Str="select*into[Paradox4.X;database="&myPath&"]."&myStr&"fromCustomers"

.DefaultExt="*.DB"

EndIf

EndWith
　　

'*****生成文件

Debug.PrintExport_Str

IfrsExport.State=1Then

rsExport.Close

EndIf　

IfDir(Dialog1.FileName)<>""Then

OnErrorGoTomyError'防用户没选文件

IfDialog1.FilterIndex<>2Then

Kill(Dialog1.FileName)

EndIf

rsExport.OpenExport_Str,conn,adOpenStatic,adLockOptimistic

Else

rsExport.OpenExport_Str,conn,adOpenStatic,adLockOptimistic

EndIf

myError:

ExitSub

EndSub　　

PrivateSubForm_Load()

'联接数据库并打开记录集

conn.CursorLocation=adUseServer

conn.Open"PROVIDER=Microsoft.Jet.OLEDB.4.0;DataSource=" App.Path "\NWind.mdb;"

rsExport.Open"select*fromCustomers",conn,adOpenStatic,adLockOptimistic

SetGrid1.DataSource=rsExport

'初始化对话筐

WithDialog1

.Filter="FoxBase/FoxPro(*.DBF)　*.DBF　Access8.0(*.MDB)　*.MDB　Excel8.0(*.XLS)　*.XLS　Paradox4.x(*.DB)　*.DB"

.DialogTitle="导出文件为"

.CancelError=False

EndWith

EndSub

->