导入导出是程序中非常重要的组成部分。Access中,系统有自带的导入导出功能。但是功能过于死板。
下面的示例我们用代码设计一个Access查询或者表导出到指定的Excel工作表
如下图。导出按钮
详细源码:
'---------------------------------------------------------------------------------------
' Procedure : QueryToExcel
' DateTime : 2008-12-2 00:02
' Author : Henry D. Sy
' Purpose : strQueryName 查询名(表名)
' xlsName 工作簿名
' strShtName 工作表名
' 需要引用Microsoft Excel 11.0 Object Library
'---------------------------------------------------------------------------------------
'
Sub QueryToExcel(ByVal strQueryName As String, ByVal xlsName As String, ByVal _
strShtName As String)
' Send the Query results to Excel
' for further analysis
Dim rs As ADODB.Recordset
Dim objXL As Excel.Application
Dim objWs As Excel.Workbook
Dim fld As ADODB.Field
Dim intCol As Integer
Dim intRow As Integer
Set rs = New ADODB.Recordset
' Get the desired data into a recordset
rs.Open strQueryName, CurrentProject.Connection
' Launch Excel
Set objXL = New Excel.Application
' Open a worksheet
Set objWs = objXL.Workbooks.Open(CurrentProject.Path & "" & xlsName & _
".xls")
objWs.Worksheets(strShtName).Activate
' Copy the data
' First the field names
For intCol = 0 To rs.Fields.Count - 1
Set fld = rs.Fields(intCol)
objWs.Worksheets(strShtName).Cells(1, intCol + 1) = fld.Name
Next intCol
' Now the actual data
intRow = 2
Do Until rs.EOF
For intCol = 0 To rs.Fields.Count - 1
objWs.Worksheets(strShtName).Cells(intRow, intCol + 1) = _
rs.Fields(intCol).Value
Next intCol
rs.MoveNext
intRow = intRow + 1
Loop
' Make the worksheet visible
objXL.Visible = True
rs.Close
Set rs = Nothing
End Sub
窗体调用代码:
Private Sub Command0_Click()
QueryToExcel "要导出的查询(表)名", "工作簿名", "工作表名"
End Sub