[此贴子已经被作者于2007-1-3 19:03:06编辑过]

[此贴子已经被作者于2007-1-9 12:12:05编辑过]

Public Sub E2Excel(ByVal rs As ADODB.Recordset)
If rs.RecordCount = 0 Then
MsgBox "没有找到符合条件的数据！", vbExclamation, "提示"
Exit Sub
End If

Dim lngRecordCount As Long ' 记录数
Dim intFieldCount As Integer ' 字段数
Dim strFields As String ' 所有字段名
Dim i As Integer

'// 取得记录总数，+ 1 是表示还有一行字段名名称信息
lngRecordCount = rs.RecordCount + 1
intFieldCount = rs.Fields.Count - 1
For i = 0 To intFieldCount
'// 生成字段名信息（vbTab 在 Excel 里表示每个单元格之间的间隔）
strFields = strFields & rs.Fields(i).name & vbTab
Next

'// 去掉最后一个 vbTab 制表符
strFields = Left$(strFields, Len(strFields) - Len(vbTab))

'// 创建Excel实例
Dim MyExcel As New Excel.Application, MyBook As New Excel.Workbook, MySheet As New Excel.Worksheet
Set MyBook = MyExcel.Workbooks.Add '添加一个新的BOOK
Set MySheet = MyBook.Worksheets(1) 'mybook.Worksheets.Add 为添加一个新的SHEET
MyExcel.Visible = True

'// 清除“剪切板”
Clipboard.Clear
'// 将字段名称复制到“剪切板”
Clipboard.SetText strFields
'// 选中A1单元格
MySheet.Range("A1").Select
'// 粘贴字段名称
MySheet.Paste
'// 从A2开始复制记录集
MySheet.Range("A2").CopyFromRecordset rs 'MySheet.Cells.CopyFromRecordset rs

'// 最合适的列宽
MyExcel.Selection.CurrentRegion.Columns.AutoFit
MyExcel.Selection.CurrentRegion.Rows.AutoFit

'MyBook.SaveAs ("ExportToExcel") '保存文件
End Sub



Call E2Excel(DataGrid１.DataSource)