vb读取access数据库写入excel

Question

'使用须知:1、添加对：Microsoft Access 11.0 Object Library的引用
Option Explicit
Dim accP As Access.Application
Dim strSourcePath As String
Dim strReportPath As String
Dim strObjectName As String
Private Sub Command1_Click()
    With cdlP
         .DialogTitle = "数据转换"
        .InitDir = App.Path & "\数据文件\"
        .Filter = "数据文件 (*.mdb)|*.mdb"
        .ShowOpen
        strSourcePath = .FileName
    End With
    strObjectName = "TB_Team"               '注意，这个名称必须和你选中的数据库中要转换的表格名称一样
    strReportPath = App.Path & "\11.xls"    '要生成的文件名
    If strSourcePath <> "" Then
        Set accP = GetObject(strSourcePath, "Access.Application")
        accP.DoCmd.OutputTo acOutputTable, strObjectName, acFormatXLS, strReportPath
        accP.CloseCurrentDatabase
        Set accP = Nothing
    End If
End Sub

Answer 1

'引用Microsoft Access 11.0 Object Library'Private Sub Command1_Click()
    Dim handle As Boolean
    Dim xlApp     As Excel.Application
    Dim xlbook     As Excel.Workbook
    Dim xlsheet     As Excel.Worksheet
    '检查文件是否已经存在,并且转换前要关闭
    handle = FileIsOpen(App.Path & "\bb.xls")
    If handle Then
        MsgBox "请先关闭EXCEL文件!", vbOKOnly + vbInformation, "不能对已经打开的文件进行写操作!"
        Exit Sub
    Else
        Call MDB2Excel(App.Path & "\stock01.mdb", "行情", App.Path & "\bb.xls") '改为你自己的库名与表名
        MsgBox "保存OK"
        '下面几句为打开转换完毕的XLS文件
        Set xlApp = GetObject(Mdbnm, "Excel.Application")
        xlApp.Visible = True '设为false，不可见
        Set xlbook = xlApp.Workbooks.Open(App.Path & "\bb.xls")
        Set xlsheet = xlbook.Worksheets(1)
        'xlApp.Quit'关闭EXCEL文件
        Set xlApp = Nothing
    End If
End SubRem 此函数完成mdb文件转为excel
Public Sub MDB2Excel(Mdbnm As String, MdbTable As String, Excelnm As String)
    On Error Resume Next
    Dim acApp As Object
    Set acApp = GetObject(Mdbnm, "Access.Application")
    xlApp.Visible = False
    acApp.DoCmd.OutputTo acOutputTable, MdbTable, "Microsoft Excel (*.xls)", Excelnm
    acApp.CloseCurrentDatabase
    acApp.Quit
    Set acApp = Nothing
End Sub

Answer 2

我自己写的代码：
With CommonDialog1
   .Action = 2
   .CancelError = False
   .Filter = "Excel文件(*.xls)|*.xls"
End With
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(App.Path & "\model\others.xls")
xlApp.Visible = False  '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("Sheet1")    '设置活动工作表
With xlSheet
    .Range("C4") = Trim(Text1.Text)
    .Range("C5") = Trim(Text2.Text)
End With
xlBook.SaveAs CommonDialog1.FileName & ".xls"
xlApp.Quit
Set xlApp = Nothing
MsgBox "数据已成功导出到" & CommonDialog1.FileName & ".xls", , "导出提示"
之前加上一段查询的程序，把数据库字段值独到TEXT中即可。