Question

vb6如何讲ACCESS数据库中的一张表里全部数据以Excel格式保存到本计算机

现有gzgl.mdb数据库文件，内有员工信息表，把整张表里的信息到都以Excel保存到本地
生成Excel表保存到本地磁盘 我的邮箱地址：d030732@qq.com

Answer 1

Private Sub Command4_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String

cn.open "provider=Microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "/gzgl.mdb"
sql = "select * from " & List1.Text & ""
rs.Source = sql

Set rs.ActiveConnection = cn
rs.LockType = adLockOptimistic
rs.CursorLocation = adUseClient
rs.open sql, cn

Dim i As Integer
Dim j As Integer
Dim xlExcel As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

set xlExcel = New Excel.Application
xlExcel.Visible=false

Set xlBook = xlExcel.Workbooks.Add
Set xlSheet = xlExcel.Worksheets.Add

If rs.RecordCount < 1 Then
MsgBox "没有数据导出", vbOKOnly + vbCritical, "错误提示"
Exit Sub
Else
'---保存对话框---
With CommonDialog2
.InitDir = App.Path '将CommonDialog1打开时初始路径设为当前程序路径
.Filter = "Excel (*.xls)|*.xls|" '设置其过滤属性为xls文件，就是只显示该文件夹内xls文件
.CancelError = True '如果点了取消键，不用报错，直接跳过
.DialogTitle = "导出数据库" '保存对话框标题
.ShowSave '弹出保存对话框
End With
End If

'---修改工作表名以及表内添加框---
xlBook.ActiveSheet.name = "测试导出数据"
xlSheet.Cells.Columns(10).ColumnWidth = 20 '列宽度
xlSheet.Cells(1, 1) = "测试1"
xlSheet.Cells(1, 2) = "测试2"
xlSheet.Cells(1, 3) = "测试3"
xlSheet.Cells(1, 4) = "测试4"
xlSheet.Cells(1, 5) = "测试5"
xlSheet.Cells(1, 6) = "测试6"
xlSheet.Cells(1, 7) = "测试7"
xlSheet.Cells(1, 8) = "测试8"
xlSheet.Cells(1, 9) = "测试9"
xlSheet.Cells(1, 10) = "测试10"

For i = 2 To rs.RecordCount + 1
For j = 1 To rs.Fields.Count
xlSheet.Cells(i, j) = rs.Fields.Item(j - 1).Value
Next j
rs.MoveNext
Next i

If CommonDialog2.filename <> "" Then
xlBook.SaveAs CommonDialog2.filename '保存数据
ElseIf CommonDialog2.filename = "" Then
Exit Sub
Else
If exist = False Then MsgBox "没有可供备份的数据表!", vbOKOnly, "注意"
End If

Set xlSheet = Nothing '释放
Set xlBook = Nothing '释放

xlExcel.Quit '用 Quit 方法关闭 Microsoft Excel '释放对象
Set xlExcel = Nothing '释放
MsgBox "测试导出数据成功", 0 + 48, "信息提示！"

rs.close
cn.close

End Sub