在VB6中匯出EXCEL，FOXPRO，PRODOX格式的表 (轉)

在VB6中匯出EXCEL，FOXPRO，PRODOX格式的表 (轉)[@more@]

 

MIS在月末由於業務的需要總要彙總當月業務情況，並且匯出報盤，我把我的中的這一部分功能單拿出來，做成一個小的程式，僅供參考。

一般是在ACCESS或是SERVER中查尋，或是彙總，然後生成一個‘記錄集’可以顯示在GRID裡，也可以將這個記錄集匯出到中。

下面可以匯出Xls,F,DB,MDB(表）,這些功能是由ISAM介面實現，為了匯出各種版本的，我在MS網站了最新的JET4和MDAC6。前者到用於桌面資料庫如ACCESS，FOXPRO的，後者是實現新版本ADO元件。分別在：
..com/download//SP/4.0/NT5/EN-US/Jet40SP5_W2K.exe">
Me/CN/mdac_typ.exe">

這些是標準的SQL匯出語句：
* into [ 8.0;database=匯出目錄].匯出表名 from 表
select * into [FoxPro 2.6;database=匯出目錄].匯出表名 from 表
select * into [FoxPro 2.5;database=同上].匯出表名 from 表
select * into [se III;database=同上].匯出表名 from 表
select * into [Paradox 4.X;database=同上].匯出表名 from 表
select * into [;database=C:tempxxx.mdb].匯出表名 from 表
下面程式為實現自定議檔名用變數代替一部分。

點這裡下載原程式檔案。

'請先引用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, myPAs 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

'*****生成檔案
De.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 "PROVR=Microsoft.Jet.OLEDB.4.0;Data =" + 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