在Access中将数据导出到Excel非常简单，我们只要将查询出的RecordSet用循环或者固定格子的方式写到Excel中即可。下面是一个小例子：
Private Function F_Export() As Boolean
Dim cnCurrent1 As ADODB.Connection
Dim rcdTemp1 As ADODB.Recordset
Dim ExcelApp
Dim ExcelWorkBook
Dim ExcelWorkSheet
Dim NetNum As Integer
Dim NetSum As Double
Dim TNum As Integer
Dim TSum As Double
Dim Side As String
On Error GoTo ErrHandle
F_T1SumExport = False
Set cnCurrent1 = CurrentProject.Connection
Set rcdTemp1 = New ADODB.Recordset
Dim querySql1 As String
NetSum = 0
querySql1 = "S Q L"
rcdTemp1.Open querySql1, cnCurrent1, adOpenKeyset
If rcdTemp1.RecordCount > 0 Then
NetNum = rcdTemp1.RecordCount
rcdTemp1.MoveFirst
Do While Not rcdTemp1.EOF
'
‘do sth
'
rcdTemp1.MoveNext
Loop
End If
rcdTemp1.Close
Set rcdTemp1 = Nothing
Set cnCurrent1 = Nothing
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set ExcelWorkBook = ExcelApp.WorkBooks.Add()
Set ExcelWorkSheet = ExcelWorkBook.WorkSheets(1)
'设置标题单元格字体颜色大小
ExcelWorkSheet.Range("A1").Select
With ExcelApp.Selection
.Font.Name = "Arial Unicode MS"
.Font.Size = "12"
.Font.Bold = True
End With
'设置正文单元格字体颜色大小
ExcelWorkSheet.Range("A2:F11").Select
With ExcelApp.Selection
.Font.Name = "Arial Unicode MS"
.Font.Size = "10"
'.Font.ColorIndex = 5
End With
'设置边框
ExcelWorkSheet.Range("A6:C9").Select
With ExcelApp.Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
'.ColorIndex = 5
End With
ExcelWorkSheet.Cells(1, 1) = "s t h"
'写数据到Excel
ExcelWorkSheet.Cells(3, 4) = Me.txt_date1.Value
ExcelWorkSheet.Cells(7, 2) = NetNum
'合并单元格
'D = "A" + CStr(1 + 4 + 1) + ":C" + CStr(1 + 4 + 1)
'ExcelWorkSheet.Range(D).Select
'With ExcelApp.Selection
'.VerticalAlignment = -4108
'.Orientation = 0
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.MergeCells = True
'End With
F_Export = True
On Error GoTo 0
Exit Function
ErrHandle:
MsgBox Error(Err), vbExclamation
End Function
