导出EXCEL/FOXPRO/PRODOX格式表

　　一般是在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''>Excel 8.0;database=导出目录].导出表名 from 表

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

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

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

　　select * into [Paradox 4.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类库。

　　Dim Export_Str, mdbTable As String

　　Dim rsExport As New ADODB.Recordset

　　Dim conn As New ADODB.Connection

　　Private Sub Close_cmd_Click()

　　Unload Me

　　End Sub

　　

　　Private Sub EXport_cmd_Click()

　　Dim myPath, myStr As String, myPos As Integer

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

　　With Dialog1

　　If myOption(2).Value Then

　　.FilterIndex = 1

　　.ShowSave

　　myStr = StrReverse(.FileName) ''串取反

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

　　On Error GoTo myError ''防FILENAME为空，MID出错

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

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

　　Export_Str = "select * into [dBase III;database=" & myPath & "]." & myStr & " from Customers"

　　.DefaultExt = "*.DBF"
　　

　　ElseIf myOption(3).Value Then

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

　　.FilterIndex = 2

　　.ShowSave

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

　　.DefaultExt = "*.MDB"　

　　ElseIf myOption(4).Value Then

　　.FilterIndex = 3

　　.ShowSave

　　Export_Str = "select * into [Excel 8.0;database=" & .FileName & "].Customers from Customers"

　　.DefaultExt = "*.XLS"　　

　　ElseIf myOption(5).Value Then

　　.FilterIndex = 4

　　.ShowSave

　　myStr = StrReverse(.FileName) ''串取反

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

　　On Error GoTo myError ''防FILENAME为空，MID出错

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

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

　　Export_Str = "select * into [Paradox 4.X;database=" & myPath & "]." & myStr & " from Customers"

　　.DefaultExt = "*.DB"

　　End If

　　End With
　　

　　''*****生成文件

　　Debug.Print Export_Str

　　If rsExport.State = 1 Then

　　rsExport.Close

　　End If　

　　If Dir(Dialog1.FileName) <> "" Then

　　On Error GoTo myError ''防用户没选文件

　　If Dialog1.FilterIndex <> 2 Then

　　Kill (Dialog1.FileName)

　　End If

　　rsExport.Open Export_Str, conn, adOpenStatic, adLockOptimistic

　　Else

　　rsExport.Open Export_Str, conn, adOpenStatic, adLockOptimistic

　　End If

　　myError:

　　Exit Sub

　　End Sub　　

　　Private Sub Form_Load()

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

　　conn.CursorLocation = adUseServer

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

　　rsExport.Open "select *from Customers", conn, adOpenStatic, adLockOptimistic

　　Set Grid1.DataSource = rsExport

　　''初始化对话筐

　　With Dialog1

　　.Filter = "FoxBase/FoxPro (*.DBF)　*.DBF　Access 8.0(*.MDB)　*.MDB　Excel 8.0(*.XLS)　*.XLS　Paradox 4.x(*.DB)　*.DB"

　　.DialogTitle = "导出文件为"

　　.CancelError = False

　　End With

　　End Sub