看看这段代码能否帮你.这是从高手那里学来的.
Public Function AccessToExcel(ByVal TempSql As String, Optional TempName As String)
'数据转Excel文件
' On Error GoTo Err:
Dim row As Integer
Dim col As Integer
Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim SQL As String
Dim ExcelApp As Excel.Application
Dim ExcelWst As Worksheet ''excel窗体
Dim RsCount As Integer ''记录数
Set Conn = CurrentProject.Connection '''本地连接
If TempSql = "" Then Exit Function
' sql = TempSql ' "select * from 书本"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open TempSql, Conn, 1 ' 1 = adOpenKeyset
Set ExcelApp = New Excel.Application
Set ExcelWst = ExcelApp.Workbooks.Add.Worksheets(1)
ExcelWst.Name = TempName
For col = 0 To Rs.Fields.count - 1
ExcelWst.Cells(1, col + 1) = Rs.Fields(col).Name
Next
row = 2
RsCount = Rs.RecordCount
Rs.MoveFirst
While Not Rs.EOF
' FunProGressBar row - 1, RsCount
For col = 0 To Rs.Fields.count - 1
ExcelWst.Cells(row, col + 1) = Rs.Fields(col)
''转换日期型字符的表示格式
If Rs.Fields(col).Type = 7 Then
ExcelWst.Cells(row, col + 1).NumberFormatLocal = "yyyy-m-d;@"
End If
Next
row = row + 1
Rs.MoveNext
Wend
'debug.print "RsCount", RsCount, row
Rs.Close
Set Rs = Nothing
Set Conn = Nothing
ExcelApp.Visible = True
Err:
' If Err.Number <> 0 Then ShowErrMsg Err.Number, Err.Description, "MSys_Comm_SystemForm.AccessToExcel"
Exit Function
End Function
