export data from vb6 to excel using ado

[azhar rumani]

I GOT CODE AFTER GOOGLING IT TO EXPORT DATA FROM VB6 TO EXCEL.CODE WORKS FINE BUT I AM ABLE TO EXPORT ONLY 26 FIELDS FROM RECORDSET.
ON ANOTHER FORM I HAVE 50 FIELDS AND THERE IS A PROBLEM I GET ERROR AT RUNTIME.

CODE:

 Dim i As Long
 
    On Error GoTo ErrorHandler
 
    Set oBook = oApp.Workbooks.Add
    Set oWorkSheet = oBook.Worksheets.Item(1)
 
    oApp.Visible = False
 
    With oWorkSheet
        c = Asc("A")
        For Each oField In rs.Fields
            .Range(Chr(c) & "1").Value = oField.Name
            .Range(Chr(c) & "1").Font.Bold = True
            c = c + 1
        Next
 
        i = 2
        'IF YOUR RECORDSET CURSOR LOCATION IS LOCAL, THEN REMOVE COMMENT FROM FOLLOWING LINE
        'If rs.RecordCount > 0 Then rs.MoveFirst
        rs.MoveFirst
        While Not rs.EOF
            c = Asc("A")
            For Each oField In rs.Fields
                .Range(Chr(c) & i).Value = rs(oField.Name)
                c = c + 1
            Next
            i = i + 1
            rs.MoveNext
        Wend
    End With
 
    oApp.Visible = True
 
    Exit Sub
 
    GoTo CleanExit
 
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
CleanExit:
    If Not oApp Is Nothing Then Set oApp = Nothing
    If Not oBook Is Nothing Then Set oBook = Nothing
    If Not oWorkSheet Is Nothing Then Set oWorkSheet = Nothing
End Sub

[MikeTheBike]

Hi

Of the top of my head, I woud say that on the 27th pass thought the loop it is trying to reference as cell with an address of "[#" instead of "AA#" (where # is some number!!)

ie Chr(91) = [

which is the Ascii characture after Z in then Ascii codes.

Therefore, as this won't work when you run out of alpherbet, I suggest something like this:-

    Dim c As Integer
    Dim i As Integer
 
    With oWorkSheet
        i = 1
        For c = 0 To rs.Fields.Count - 1
            .Cells(i, c + 1).Value = rs(c).Name
            .Cells(i, c + 1).Font.Bold = True
        Next
 
        rs.MoveFirst
 
        i = 2
        While Not rs.EOF
            For c = 0 To rs.Fields.Count - 1
                .Cells(i, c + 1).Value = rs(c)
            Next
            i = i + 1
            rs.MoveNext
        Wend
    End With

HTH

MTB

[azhar rumani]

Thanx,yeah this logic is working for me.
It really help me complete my form.