MIS系统在月末由于业务的需要总要汇总当月业务情况,并且导出报盘,我把我的程序中的这一部分功能单拿出来,做成一个小的程序,仅供参考。
一般是在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 [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

|