VB导出数据到excel

'将查询信息导出为excel文件
'输出
'输入：param1 string database名字
      '      param2 string sql语句
Public Sub SaveAsExcel(database As String, strSql As String)
Dim rs As New ADODB.Recordset
Dim objExcel As New Excel.Application
Dim objBook As New Excel.Workbook
Dim objSheet As New Excel.Worksheet
Dim rowCount As Long
Dim colCount As Integer
Dim j As Integer
Dim i As Integer

Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
On Error GoTo Error1:
Set objSheet = objBook.Worksheets.Add

Set rs = GetData(strSql, database)
colCount = rs.Fields.Count
rowCount = rs.RecordCount
For i = 0 To colCount - 1
objSheet.Cells(1, i + 1) = rs.Fields(i).Name + Chr(13)
Next

For j = 2 To rowCount + 1
For i = 0 To colCount - 1
objSheet.Cells(j, i + 1) = CStr(rs.Fields(i))
'+ Chr(10)
Next
rs.MoveNext
Next

objBook.SaveAs (App.Path + "/data.xls")
Set rs = Nothing
objBook.Close
objExcel.Quit
Set objExcel = Nothing
MsgBox "数据已经全部导出"
Exit Sub
Error1:
MsgBox Error
objBook.Close
objExcel.Quit
Set objExcel = Nothing
End Sub