导出Access数据库中的表？

在Access2000中，右键单击表可以将其导出为Excel文件。在VB程序中应该怎样实现相同的操作？将一个表导出为Excel表格？谢谢！

解决方案 »

  1.   

    在 vb 界面上也通过单击右键来执行下面的函数来实现：Public Function vExporToExcel_ADO(strOpen As String, CnnStr As String, Optional Caption As String = "导出的 Excel 文件", Optional Companyname As String = "")
    '***************************************************************************
    '* 名称：vExporToExcel_ADO
    '* 功能：通过 ADO 快速导出数据到EXCEL
    '* 用法：vExporToExcel_ADO(sql查询字符串,ADO 连接字符串,导出文件名称,总公司名称)
    '***************************************************************************
    On Error GoTo errHandlerr    Dim Rs_Data As New ADODB.Recordset
        Dim Irowcount As Integer
        Dim Icolcount As Integer
        
        Dim xlApp As New Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        Dim xlQuery As Excel.QueryTable
        
        With Rs_Data
             If .State = adStateOpen Then .Close
            .ActiveConnection = CnnStr
            .CursorLocation = adUseClient
            .CursorType = adOpenStatic
            .LockType = adLockReadOnly
            .Source = strOpen
            .Open
            
            If .RecordCount < 1 Then
                MsgBox "没有记录可供导出!", vbInformation, MsgBoxTitle
                Exit Function
            End If
            
            Irowcount = .RecordCount       '记录总数
            Icolcount = .Fields.count      '字段总数
            
        End With
        
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Set xlBook = xlApp.Workbooks().Add
        Set xlSheet = xlBook.Worksheets("sheet1")
        xlApp.Visible = True
        
        '添加查询语句，导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
        
        With xlQuery
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = True
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
        
            .FieldNames = True '显示字段名
            .Refresh
        
        End With
        
        
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"                              '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = False 'True                         '标题字体不加粗
            .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous    '设表格边框样式
                    
             With .PageSetup   '打印时的页眉页脚设置
                  .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" + Companyname                                                                            '打印 左页眉
                  .CenterHeader = "&""楷体_GB2312,常规""" + Caption + "&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10打印日期：" + Format(Date, "YYYY-MM-DD")         '打印 中页眉
                  .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10打印时间：" + Format(Time, "HH:MM:SS       ")                                                       '打印 右页眉
                  .LeftFooter = "&""楷体_GB2312,常规""&10制表人："                                                                                                           '打印 左页脚
                  .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" + Format(Date, "YYYY-MM-DD")                                                                          '打印 中页脚
                  .RightFooter = "&""楷体_GB2312,常规""&10第 &P 页 共 &N 页       "                                                                                          '打印 右页脚
             End With
        
        End With
            
        xlApp.Application.Visible = True
        Set xlApp = Nothing              '交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = NothingExit FunctionerrHandlerr:
    MsgBox err.Description + "：" + CStr(err.number), vbCritical, MsgBoxTitleEnd Function
      

  2.   

    方法二：Public Function vExporToExcel_DAO(strOpen As String, TabAddress As String, Optional Caption As String = "导出的 Excel 文件", Optional Companyname As String = "", Optional DataPassWord As String = "")
    '***************************************************************************
    '* 名称：vExporToExcel_DAO
    '* 功能：通过 DAO 快速导出数据到EXCEL
    '* 用法：vExporToExcel_DAO(sql查询字符串,DAO 连接数据库路径和名称,导出文件名称,总公司名称,数据库密码)
    '***************************************************************************
    On Error GoTo errHandlerr    Dim OpenWs As Workspace
        Dim OpenDB As Database
        Dim RsData As Recordset
        
        Dim Irowcount As Integer
        Dim Icolcount As Integer
        
        Dim xlApp As New Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        Dim xlQuery As Excel.QueryTable
        
        Set OpenWs = DBEngine.Workspaces(0)
        Set OpenDB = OpenWs.OpenDatabase(TabAddress, False, False, "MS Access;PWD=" + DataPassWord)
        Set RsData = OpenDB.OpenRecordset(strOpen, dbOpenSnapshot)    With RsData
            
             If .RecordCount < 1 Then
                 MsgBox "没有记录可供导出!", vbInformation, MsgBoxTitle
                 Exit Function
             End If
            .MoveLast
            .MoveFirst
             Irowcount = .RecordCount       '记录总数
             Icolcount = .Fields.count      '字段总数
            
        End With
        
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Set xlBook = xlApp.Workbooks().Add
        Set xlSheet = xlBook.Worksheets("sheet1")
        xlApp.Visible = True
        
        '添加查询语句，导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(RsData, xlSheet.Range("a1"))
        
        With xlQuery
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = True
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
        
            .FieldNames = True '显示字段名
            .Refresh
        
        End With
        
        
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"                              '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = False 'True                         '标题字体不加粗
            .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous    '设表格边框样式
                    
             With .PageSetup   '打印时的页眉页脚设置
                  .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" + Companyname                                                                            '打印 左页眉
                  .CenterHeader = "&""楷体_GB2312,常规""" + Caption + "&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10打印日期：" + Format(Date, "YYYY-MM-DD")         '打印 中页眉
                  .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10打印时间：" + Format(Time, "HH:MM:SS       ")                                                       '打印 右页眉
                  .LeftFooter = "&""楷体_GB2312,常规""&10制表人："                                                                                                           '打印 左页脚
                  .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" + Format(Date, "YYYY-MM-DD")                                                                          '打印 中页脚
                  .RightFooter = "&""楷体_GB2312,常规""&10第 &P 页 共 &N 页       "                                                                                          '打印 右页脚
             End With
        
        End With
            
        xlApp.Application.Visible = True
        Set xlApp = Nothing              '交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = Nothing
    Exit FunctionerrHandlerr:
    MsgBox err.Description + "：" + CStr(err.number), vbCritical, MsgBoxTitle
    End Function
      

  3.   

    方法三：Public Function vExporToExcel_Recordset(Rst As Object, CnnStr As String, Optional Caption As String = "导出的 Excel 文件", Optional Companyname As String = "")
    '****************************************************************************************
    '* 名称：vExporToExcel_Recordset
    '* 功能：通过 Recordset记录集（包含 ADO 和 DAO 记录集） 快速导出数据到 EXCEL
    '* 用法：vExporToExcel_Recordset(Recordset记录集,空串,导出文件名称,总公司名称)
    '****************************************************************************************
    On Error GoTo errHandlerr    Dim Irowcount As Integer
        Dim Icolcount As Integer
        
        Dim xlApp As New Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        Dim xlQuery As Excel.QueryTable
        
        With Rst
            
             If .RecordCount < 1 Then
                 MsgBox "没有记录可供导出!", vbInformation, MsgBoxTitle
                 Exit Function
             End If
            
             Irowcount = .RecordCount       '记录总数
             Icolcount = .Fields.count      '字段总数
            
        End With
        
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Set xlBook = xlApp.Workbooks().Add
        Set xlSheet = xlBook.Worksheets("sheet1")
        xlApp.Visible = True
        
        '添加查询语句，导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(Rst, xlSheet.Range("a1"))
        
        With xlQuery
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = True
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
        
            .FieldNames = True '显示字段名
            .Refresh
        
        End With
        
        
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"                              '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = False 'True                         '标题字体不加粗
            .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous    '设表格边框样式
                    
             With .PageSetup   '打印时的页眉页脚设置
                  .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" + Companyname                                                                            '打印 左页眉
                  .CenterHeader = "&""楷体_GB2312,常规""" + Caption + "&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10打印日期：" + Format(Date, "YYYY-MM-DD")         '打印 中页眉
                  .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10打印时间：" + Format(Time, "HH:MM:SS       ")                                                       '打印 右页眉
                  .LeftFooter = "&""楷体_GB2312,常规""&10制表人："                                                                                                           '打印 左页脚
                  .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" + Format(Date, "YYYY-MM-DD")                                                                          '打印 中页脚
                  .RightFooter = "&""楷体_GB2312,常规""&10第 &P 页 共 &N 页       "                                                                                          '打印 右页脚
             End With
        
        End With
            
        xlApp.Application.Visible = True
        Set xlApp = Nothing              '交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = Nothing
        
    Exit FunctionerrHandlerr:
    MsgBox err.Description + "：" + CStr(err.number), vbCritical, MsgBoxTitle
    End Function说明：以上三法钧取自 http://dev.csdn.net/develop/article/14/14952.shtm 
      

  4.   

    上面复杂的就不好处理了
    下面的代码其实就是access的导出
    试试
    Option Explicit
    '引用microsoft access 9.0 object library
    Private Sub Command1_Click()
    Dim acapp As Access.application
    Dim dbpath As String
    Dim xpath As String
    dbpath = App.Path & "\data.mdb"
    xpath = App.Path & "\data.xls"Set acapp = GetObject(dbpath, "access.application")
    acapp.docmd.TransferSpreadsheet axexport, acSpreadsheetTypeExcel9, "类别", xpathEnd Sub
      

  5.   

    acapp.docmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "类别", xpath
    "类别"是表
      

  6.   

    我試驗了再戰江湖的程序.怎么彈出錯誤提示:因為資料庫不存在. 或被其他使用者以獨占模式開啟了,導致Microsoft Access不能開啟資料庫.
     
    是咋回事情啊?
      

  7.   

    Access 数据库有密码吧，你在打开 数据库 时出错！不知你是怎么去打开数据库的！
      

  8.   

    是通過ADO控件打開的. 哪里能找到Access 数据库有密码?
      

  9.   

    我的方法中打开 Acces 数据库时的连接字符串可以这样写：连接字符串：
    ConnectionString= "provider=Microsoft.Jet.OLEDB.4.0;Data source =" + [Access97、Access2000 数据库路径及名称] + " ;Persist Security Info=False;Jet OLEDB:Database Password=" + [数据库密码]此处的[Access97、Access2000 数据库路径及名称] 也即为 dbfilename，定义成字符即可：
    dim dbfilename as string
    并付值：dbfilename="\\servername\D$\...\order.mdb" 即可，此处的 D$\... 代表数据库在服务器的 D 盘及其路径（$ 意思是此数据库你可不必有意识的去共享也可访问）注意：数据库有密码时，“Jet OLEDB:Database Password=" + [数据库密码]” 句不可少！用以上连接字符串就可以用 ADODC 和 ADODB 打开有密码 Access 数据库，从而可实现导出功能！
      

  10.   

    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://jinesc.6600.org/myweb/disp.asp?idd=80&room=1010
      

  11.   

    Option Explicit
    '引用microsoft access 9.0 object library
    Private Sub Command1_Click()
    Dim acapp As Access.Application
    Dim dbpath As String
    Dim xpath As String
    dbpath = App.Path & "\data.mdb"
    xpath = App.Path & "\data.xls"Set acapp = GetObject(dbpath, "access.application")
    acapp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "orders", xpathEnd Sub
    前提是data.xls,data.mdb文件存在，且data.mdb存在orders表，