vb记录写到Excel中

Question

Dim Conn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim Cmd As New ADODB.Command
Dim Cmd1 As New ADODB.CommandDim sSql As String
Dim connStr As String
Dim ConnExcel As New ADODB.Connection'打开excel表
connStr = "Provider=MSDASQL.1;Driver={Microsoft Excel Driver (*.xls)};DBQ=C:\My Documents\XXXX.xls"
ConnExcel.Open connStr
Set Cmd.ActiveConnection = ConnExcel
Cmd.CommandType = adCmdTable
Cmd.CommandText = "[sheet1$]"
Set rs = Cmd.Execute'打开SQL Server表
Conn.ConnectionString= "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=你的数据库服务名;Data Source=你的数据源"
Conn.Open
rs1.CursorLocation = adUseClient
rs1.LockType = adLockBatchOptimistic
rs1.CursorType = adOpenKeyset
sSql = "select * from XXXX"   
rs1.open sSqlcnn,conn

Answer 1

别人写的代码（借来学习）：Private Function RsToExcel(ByVal Rs As Object, ByVal vFilename As String, ByRef lSumRecord As Long) As Long
'把记录集的内容保存到excel文件中
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Sheets
Dim j As Long, i As Long    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Add
    Set oSheet = oBook.Worksheets(1)
'#########方法一######################
    lSumRecord = 0
'    On Error Resume Next
    While Not Rs.EOF
        j = j + 1
        pgbRead.Value = j
        For i = 0 To Rs.Fields.Count - 2
            oSheet.Range(Trim(Chr(97 + i)) & CLng(j)) = Trim(Rs.Fields(i + 1))
            DoEvents
        Next
        lSumRecord = lSumRecord + 1
        Rs.MoveNext
        DoEvents
    Wend
    
    pgbRead.Value = 1
'#########方法二#######################
'    oSheet.Range("A").CopyFromRecordset Rs
    
    If chkHavePassword.Value Then
        oBook.SaveAs vFilename, , sRPassword, sWPassword
    Else
        oBook.SaveAs vFilename
    End If
    oExcel.Quit
    Set oSheet = Nothing
    Set oBook = Nothing
    Set oExcel = Nothing
   
End Function