引用EXCEL

　　Dim xlApp As Excel.Application

　　Dim xlBook As Workbook, xlSheet As Worksheet

　　Set xlApp = CreateObject("Excel.Application")

　　Set xlApp = New Excel.Application

　　Set xlBook = xlApp.Workbooks.Open(EXECL文件名) '打开要输出的EXECL文件

　　Set xlSheet = xlBook.Worksheets(1) '打开工作表,这里是第一个,可以设其他

　　xlApp.Visible = True '显示

　　xlSheet.CELLS(3, 3) = "'" & 要输出的内容 'CELLS(行,列) 单元格

　　xlSheet.PrintPreview '如果是要打印，只要把 PrintPreview 改为 PrintOut

　　xlBook.Close SaveChanges:=False

　　xlApp.Quit '退出

　　****************

　　For iCols = 0 to rs.Fields.Count - 1

　　ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name

　　Next

　　ws.Range(ws.Cells(1, 1), _

　　ws.Cells(1, rs.Fields.Count)).Font.Bold = True

　　ws.Range("A2").CopyFromRecordset rs

　　*****************************

　　Private Sub CommandButton1_Click()

　　Dim CNN As New ADODB.Connection

　　Dim RST As New ADODB.Recordset

　　Dim Stpath, strSQL As String

　　Stpath = ThisWorkbook.Path & Application.PathSeparator & "学生档案.mdb"

　　CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath '& ";Jet OLEDB:Database Password=" & "123"

　　If ComboBox3.Value = "" Then

　　strSQL = "Select * from 档案 WHERE 籍贯 LIKE '" & ComboBox2.Value & "'"

　　ElseIf ComboBox2.Value = "" Then

　　strSQL = "Select * from 档案 WHERE 性别 LIKE '" & ComboBox3.Value & "'"

　　Else

　　strSQL = "Select * from 档案 WHERE 性别 LIKE '" & ComboBox3.Value & "'" & "AND 籍贯 LIKE '" & ComboBox2.Value & "'"

　　End If

　　RST.Open strSQL, CNN

　　Sheet1.Range("A2:G10000").ClearContents '删除原内容

　　Sheet1.Cells(2, 1).CopyFromRecordset RST

　　RST.Close

　　Set RST = Nothing '示放RST 的内存

　　Set CNN = Nothing '示放CNN的内存

　　End Sub