MS Access导出到.xls

时间:2013-04-03 21:07:00

标签: ms-access ms-access-2007 xls

我正在寻找样本“源代码”来执行此操作,因此我可以创建一个按钮来自动将所有表格导出为具有相同名称但扩展名为.xls的表单。我已经知道如何手动导出表格。

1 个答案:

答案 0 :(得分:1)

我还没有经过测试,但是这样的东西应该适用于导出到同一个工作簿......

Dim lTbl As Long
Dim strFile As String
Dim d As Database

 'Set current database to a variable adn create a new Excel instance
Set d = CurrentDb

strFile = "c:\FolderName\FileName.xls" '## Change to file you want

'Loop through all tables
For lTbl = 0 To d.TableDefs.Count
     'If the table name is a temporary or system table then ignore it
    If Left(d.TableDefs(lTbl).Name, 1) = "~" Or _
        Left(d.TableDefs(lTbl).Name, 4) = "MSYS" Then
         '~ indicates a temporary table
         'MSYS indicates a system level table
    Else
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, d.TableDefs(lTbl).Name, strFile
    End If
Next lTbl

 'Release database object from memory
Set d = Nothing

或者对于所有单独的工作簿:

Dim lTbl As Long
Dim strFile As String
Dim d As Database

 'Set current database to a variable adn create a new Excel instance
Set d = CurrentDb
Set xlApp = CreateObject("Excel.Application")

strFilePath = "c:\Database\" '## Cahnge to where you want to save"

'Loop through all tables
For lTbl = 0 To d.TableDefs.Count
     'If the table name is a temporary or system table then ignore it
    If Left(d.TableDefs(lTbl).Name, 1) = "~" Or _
        Left(d.TableDefs(lTbl).Name, 4) = "MSYS" Then
         '~ indicates a temporary table
         'MSYS indicates a system level table
    Else
        Set wbExcel = xlApp.workbooks.Add
        strFile = d.TableDefs(lTbl).Name & ".xls"
        wbExcel.SaveAs FileName:=strFilePath & strFile, FileFormat:=56
        wbExcel.Close
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, d.TableDefs(lTbl).Name, strFilePath & strFile
        Set wbExcel = Nothing
    End If
Next lTbl

xlApp.Quit
Set wbExcel = Nothing
Set xlApp = Nothing

 'Release database object from memory
Set d = Nothing