Exporting to Excel via VB

[bombdropVB]

Hi I'm trying to export to excel via vb ( DTS in SQL Server will not work du to the fact the sp uses a curssor)

the sp returns 16 recordset not all them filled. the code is ment to loop through the recordset export them to a idervidual sheet in a excell spread sheet. it does the first couple then forgets the rest any help anyone!!!!

Option Explicit

Private Sub Command1_Click()

    Dim conExport   As ADODB.Connection
    Dim recExport           As New ADODB.Recordset
    Dim oxlApp              As Excel.Application
    Dim oxlBook             As Excel.Workbook
    Dim oxlSheet            As Excel.Worksheet
    Dim blnRecordGotSets    As Boolean
    Dim intSheetCounter     As Integer


    Set conExport = New ADODB.Connection
    Set recExport = New ADODB.Recordset



    ' Open the connection.
    conExport.Open _
        "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=ace;Data Source=LVP-GANDAPI"

    'open the recordset will return multiple
    recExport.Open "sb_testc", conExport


    ' Open the destination Excel workbook.

    Set oxlApp = New Excel.Application
    Set oxlBook = oxlApp.Workbooks.Add





    If recExport.EOF Then
        Set recExport = recExport.NextRecordset
        If recExport.EOF Then
            blnRecordGotSets = False
        Else
            blnRecordGotSets = True
        End If 'recExport.EOF
    Else
        blnRecordGotSets = True
    End If 'recExport.EOF
    intSheetCounter = 0
    Dim strHandler As String
    While blnRecordGotSets = True
        intSheetCounter = intSheetCounter + 1
        If intSheetCounter > 3 Then
            oxlBook.Worksheets.Add
        End If 'ntSheetCounter > 3
        Debug.Assert intSheetCounter <> 4
        'While Not recExport.EOF
        oxlBook.Worksheets(intSheetCounter).Cells(1, 1) = "Our Ref"
        oxlBook.Worksheets(intSheetCounter).Cells(1, 2) = "Clientshort"
        oxlBook.Worksheets(intSheetCounter).Cells(1, 3) = " handler"
        oxlBook.Worksheets(intSheetCounter).Cells(1, 4) = " Description"
        oxlBook.Worksheets(intSheetCounter).Cells(1, 5) = " Reserve"

        strHandler = recExport!handler & ""
        oxlBook.Worksheets(intSheetCounter).Range("a2").CopyFromRecordset recExport
        
        Set oxlSheet = oxlBook.Worksheets(intSheetCounter)
        
        oxlSheet.Name = strHandler
        
        Set recExport = recExport.NextRecordset

        If recExport.EOF Then
            Set recExport = recExport.NextRecordset
            If recExport.EOF Then
                blnRecordGotSets = False
            Else
                blnRecordGotSets = True
            End If 'recExport.EOF
        Else
            blnRecordGotSets = True
        End If 'recExport.EOF

    Wend


    '
    oxlBook.SaveAs "c:\ACE Open by handler.xls"
    MsgBox "finished"

    oxlBook.Close False

    oxlApp.Quit

    recExport.Close

    conExport.Close

    Set oxlBook = Nothing

    Set oxlApp = Nothing

    Set recExport = Nothing

    Set conExport = Nothing

End Sub

Thanks guys

 

[bombdropVB]

solved the problem when adding the new sheets i was not sepecifying where they should be placed
i.e before or after the cyurrent active sheet.

revised code.

Private Sub Command1_Click()

    Dim conExport           As ADODB.Connection
    Dim recExport           As ADODB.Recordset
    Dim objFiled            As ADODB.Field
    Dim objApp              As Excel.Application
    Dim objBook             As Excel.Workbook
    Dim objSheet            As Excel.Worksheet

    Dim intSheetCounter     As Integer
    Dim intFieldCounter     As Integer
    Dim strHandler          As String
    Dim astrCatalog(3)      As String

    On Error GoTo Command1_Click_Error

    '/*
    'Populate the array with the name of each of the catalogs
    'held on the server
    '*/

    astrCatalog(0) = "ace"
    astrCatalog(1) = "ire"
    astrCatalog(2) = "nonscheme"
    astrCatalog(3) = "pi5"

    Set conExport = New ADODB.Connection
    Set recExport = New ADODB.Recordset


    'Open an Excel application an set it to a work book workbook.

    Set objApp = New Excel.Application
    Set objBook = objApp.Workbooks.Add


    'Open the connection.
    conExport.Open _
        "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=ace;Data Source=LVP-GANDAPI"

    'Open the recordset will return multiple
    recExport.Open "sb_testc", conExport
    intSheetCounter = 0


    While Not recExport Is Nothing

        'If redcordset has records then populate spreadsheet
        If Not recExport.EOF Then

            intSheetCounter = intSheetCounter + 1

            'After the third sheet add extra sheets
            If intSheetCounter > 3 Then
                objBook.Worksheets.Add , objSheet
            End If 'ntSheetCounter > 3

            'Get handlers name
            strHandler = recExport!handler & ""
            
            If Len(strHandler) = 0 Then
                strHandler = "NoName"
            End If 'Len(strHandler) = 0
            strHandler = Replace(strHandler, "/", "")

            'set a sheetobject to the current worksheet so it can be renamed
            Set objSheet = objBook.Worksheets(intSheetCounter)
            objSheet.Name = strHandler

            'reset for each new sheet
            intFieldCounter = 1

            'Set up column headers
            For Each objFiled In recExport.Fields

                With objSheet.Cells(1, intFieldCounter)
                    .Value = objFiled.Name
                    .Font.Bold = True
                    .Font.Size = 11
                    .Interior.Color = &H808080
                End With 'objSheet.Cells(1, intFieldCounter)

                intFieldCounter = intFieldCounter + 1
            Next 'objFiled


            'Export the recordset to the worksheet
            objSheet.Range("a2").CopyFromRecordset recExport
            objSheet.Columns.AutoFit

        End If 'Not recExport.EOF

        'Move to the next worksheet
        Set recExport = recExport.NextRecordset

    Wend 'Not recExport Is Nothing
    objBook.SaveAs "c:\ACEOpen by handler.xls"

    'Close connection to database
    conExport.Close


    'Save the Work book


    MsgBox "finished"

    objBook.Close False

    objApp.Quit



    GoTo CleanExit:

Command1_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbCr & _
        "Found In Form: Form1 " & vbCr & "Found In Procedure: Command1_Click" & _
        vbCr & IIf(Erl > 0, "Found In Line:" & Erl, ""), vbCritical, _
        "Error Occurred"

    'Call LogError ("Form1:Command1_Click",Err.Description, err.Number, erl)

CleanExit:
    On Error GoTo 0
    'Destroy all objects used

    If Not objSheet Is Nothing Then
        Set objSheet = Nothing
    End If

    If Not objBook Is Nothing Then
        Set objBook = Nothing
    End If

    If Not objApp Is Nothing Then
        Set objApp = Nothing
    End If

    If Not recExport Is Nothing Then
        Set recExport = Nothing
    End If 'Not recExport Is Nothing Then

    If Not conExport Is Nothing Then
        Set conExport = Nothing
    End If 'Not conExport  Is Nothing Then

End Sub 'Command1_Click (Sub)