MS Access导出为.xls

Question

我正在寻找示例“源代码”来执行此操作，以便我可以创建一个按钮来自动导出所有表以传播具有相同名称但具有.xls扩展名的表格。我已经知道如何手动导出表格。

Answer 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