[RESOLVED] Porting ADO Recordset To Excel

[SeanK]

This is related to my other post about the Automation error, but as it is a completely different question, so I'm posting it in a new thread.

I have an ADO recordset created in VB6. Some of the elements of this recordset is header information, and will only be used once in the, doh, header portion of the spreadsheet.

I have that working just fine. However, there are 8 other elements in the recordset the comprise the sole of the data I'm retrieveing. Like all recordset, I have no idea how many records will be returned during any particular run as the criteria for the SELECT query is user selectable.

My column headers for the data begin at A6 and go to F6. I want the loop that iterates through the recordset to start dumping the contents at A8 through F8 and continue down to Ax where x is whatever column will be the last one.

What I don't know how to do is increment the row number so that it will go from A6 to Ax. How would I do that?

(Note: I'm using Excel 2003 and VB6 SP5)

[RobDog888]

Are you using Excels .CopyFromRecordset method? It has a parameter for where to place the data.

[SeanK]

Are you using Excels .CopyFromRecordset method? It has a parameter for where to place the data.

No. CopyFromRecordSet doesn't work for me. Reference this Office Development thread.

That is why I am switching from using CopyFromRecordset to actual code to prepare my report based on my recordset.

[Hack]

This is related to my other post about the Automation error, but as it is a completely different question, so I'm posting it in a new thread.

I have an ADO recordset created in VB6. Some of the elements of this recordset is header information, and will only be used once in the, doh, header portion of the spreadsheet.

I have that working just fine. However, there are 8 other elements in the recordset the comprise the sole of the data I'm retrieveing. Like all recordset, I have no idea how many records will be returned during any particular run as the criteria for the SELECT query is user selectable.

My column headers for the data begin at A6 and go to F6. I want the loop that iterates through the recordset to start dumping the contents at A8 through F8 and continue down to Ax where x is whatever column will be the last one.

What I don't know how to do is increment the row number so that it will go from A6 to Ax. How would I do that?

(Note: I'm using Excel 2003 and VB6 SP5)

Moderators are a nasty lot with big clubs and mean looks and they use them if you bump your thread, so I'll bump this for you.

My motive is not totally pure, however, as I would like to know how to do this as well.

[DKenny]

This is how I would approach it.
Looping through the records and rows at the same time.

Then within that loop, loop through the fields and columns at the same time.

Here's some sample code to give you the idea.

Sub sample()
Dim rngRowStart As Range
Dim rsYourRecordSet As ADODB.Recordset
Dim x As Integer
 
    'Starting position for the excel table
    Set rngRowStart = ThisWorkbook.Worksheets("SheetName").Range("A6")
    
    With rsYourRecordSet
        
        'Start of recordset
        .MoveFirst
        Do
            '8 elements in the RS
            For x = 0 To 7
                'Place each element in the coresponding column
                rngRowStart.Offset(0, x).Value = .Fields(x).Value
            Next x
        
            'Next Record
            .MoveNext
            
            'Next Row
            Set rngRowStart = rngRowStart.Offset(1, 0)
        
        Loop Until .EOF
    End With
End Sub

[SeanK]

Thanks DKenny, but I'm getting a "Method or Data Member Not Found" on

rngRowStart.Offset blah

With ".Offset" being highlighted.

[DKenny]

Sean

Can you run the code to the error point and in the immediate window check the value of rngRowStart.Address.

My though here is that the issue is with the range variable. Did you change "SheetName" in the above code to the name of your desyination worksheet?

[SeanK]

I will step through it and check the value, but I don't know the name of the worksheet. I'm guessing it will be Sheet1. Here is how I'm creating it

Set objExcel = New Excel.Application
    Set bkWorkBook = objExcel.Workbooks.Add
    Set shWorkSheet = bkWorkBook.ActiveSheet

Prior to running this code, the excel file/worksheet doesn't exist.

[DKenny]

In that case don't use a name at all. You can refer to the sheet by its index in the worksheets collection.

Changing your last posted code to...

Set objExcel = New Excel.Application
    Set bkWorkBook = objExcel.Workbooks.Add
    Set shWorkSheet = bkWorkBook.Worksheets(1)
    Set rngRowStart = shWorkSheet.Range("A6")

[SeanK]

In that case don't use a name at all. You can refer to the sheet by its index in the worksheets collection.

Changing your last posted code to...

Set objExcel = New Excel.Application
    Set bkWorkBook = objExcel.Workbooks.Add
    Set shWorkSheet = bkWorkBook.Worksheets(1)
    Set rngRowStart = shWorkSheet.Range("A6")

Ok. I did this, and I'm still getting the "Method or Data Member Not Found" on .Offset

[DKenny]

Can you post the entire procedure? Or at least the line that is giving the error.

[SeanK]

This is everything minus the acutal query that creates the recordset, which is working just fine.

Set objExcel = New Excel.Application
    Set bkWorkBook = objExcel.Workbooks.Add
    Set shWorkSheet = bkWorkBook.Worksheets(1)
    'Set shWorkSheet = bkWorkBook.ActiveSheet
        shWorkSheet.Range("A1") = "Company Name:  " & adoRS(4) 'ordinal position for provider name
        shWorkSheet.Range("A2") = "Company Number:  " & adoRS(5) 'ordinal position for provider code
        shWorkSheet.Range("C1") = "FYE:  " & cboFYE.Text
        shWorkSheet.Range("A3") = "Type:  " & cboType.Text
        shWorkSheet.Range("C3") = "Number " & pstrOrderNumber
        shWorkSheet.Range("A6") = "Item No"
        shWorkSheet.Range("A6") = "Item"
        shWorkSheet.Range("B6") = "Processor"
        shWorkSheet.Range("C6") = "Disposition Type"
        shWorkSheet.Range("D6") = "Unit Price"
        shWorkSheet.Range("E6") = "Total Price"
        shWorkSheet.Range("F6") = "Comments"
'Do While Not adoRS.EOF
Dim rngRowStart As Range
 
Dim x As Integer
 
    Set rngRowStart = shWorkSheet.Range("A6")
    'Starting position for the excel table
    'Set rngRowStart = bkWorkBook.Worksheets("Sheet1").Range("A6")
    
    'With adoRS
        
        'Start of recordset
        adoRS.MoveFirst
        Do
            '8 elements in the RS
            For x = 0 To 7
                'Place each element in the coresponding column
                rngRowStart[HL="#FFFF80"].Offset[/hl](0, x).Value = adoRS(5) '<===this is highlighted when I get the error message.
                rngRowStart.Offset(0, x).Value = adoRS(2)
                rngRowStart.Offset(0, x).Value = adoRS(9)
                rngRowStart.Offset(0, x).Value = adoRS(11)
                rngRowStart.Offset(0, x).Value = adoRS(3)
                rngRowStart.Offset(0, x).Value = adoRS(4)
                rngRowStart.Offset(0, x).Value = adoRS(10)
            Next x
        
            'Next Record
            adoRS.MoveNext
            
            'Next Row
            Set rngRowStart = rngRowStart.Offset(1, 0)
        
        Loop Until .EOF
  '  End With
 
        
        shWorkSheet.Columns("A:BZ").AutoFit
        objExcel.Visible = True
adoRS.Close
Set adoRS = Nothing
 
 
End Sub

[DKenny]

the are a couple of issues here.

In your code your requirement is to put non-sequential fields from the recordset into sequential columns on the spreadsheet. The For x Next loop will not achieve this. Remove the loop and specify each mapping individually.

For x = 0 To 7
                'Place each element in the coresponding column
                rngRowStart.Offset(0, x).Value = adoRS(5) '<===this is highlighted when I get the error message.
                rngRowStart.Offset(0, x).Value = adoRS(2)
                rngRowStart.Offset(0, x).Value = adoRS(9)
                rngRowStart.Offset(0, x).Value = adoRS(11)
                rngRowStart.Offset(0, x).Value = adoRS(3)
                rngRowStart.Offset(0, x).Value = adoRS(4)
                rngRowStart.Offset(0, x).Value = adoRS(10)
            Next x

should become

'Place each element in the coresponding column
            rngRowStart.Offset(0, 0).Value = adoRS(5)
            rngRowStart.Offset(0, 1).Value = adoRS(2)
            rngRowStart.Offset(0, 2).Value = adoRS(9)
            rngRowStart.Offset(0, 3).Value = adoRS(11)
            rngRowStart.Offset(0, 4).Value = adoRS(3)
            rngRowStart.Offset(0, 5).Value = adoRS(4)
            rngRowStart.Offset(0, 6).Value = adoRS(10)

Next, I checked the offset and it is working correctly, therefore the issue has to be with the recordset object. ( I suspect that this is also the reason that the CopyFromRecordset method was failing)

Here's the code I used to check the offset, basically I removed all references to the recordset and instead put the field numbers in the correct columns and changed the DO..LOOP to a FOR..NEXT - just to show it working on multiple lines.

Sub sample()
Dim objExcel As Excel.Application
Dim bkWorkBook As Excel.Workbook
Dim shWorkSheet As Excel.Worksheet
Dim rngRowStart As Excel.Range
Dim counter As Long
 
    Set objExcel = New Excel.Application
    Set bkWorkBook = objExcel.Workbooks.Add
    Set shWorkSheet = bkWorkBook.Worksheets(1)
    
    shWorkSheet.Range("A6") = "Item No"
    shWorkSheet.Range("A6") = "Item"
    shWorkSheet.Range("B6") = "Processor"
    shWorkSheet.Range("C6") = "Disposition Type"
    shWorkSheet.Range("D6") = "Unit Price"
    shWorkSheet.Range("E6") = "Total Price"
    shWorkSheet.Range("F6") = "Comments"
 
    Set rngRowStart = shWorkSheet.Range("A7")
           
    counter = 1
    Do
        'Place each element in the coresponding column
        rngRowStart.Offset(0, 0).Value = 5
        rngRowStart.Offset(0, 1).Value = 2
        rngRowStart.Offset(0, 2).Value = 9
        rngRowStart.Offset(0, 3).Value = 11
        rngRowStart.Offset(0, 4).Value = 3
        rngRowStart.Offset(0, 5).Value = 4
        rngRowStart.Offset(0, 6).Value = 10
        
        'Next Row
        Set rngRowStart = rngRowStart.Offset(1, 0)
        
        counter = counter + 1
    Loop Until counter = 10
        
    shWorkSheet.Columns("A:BZ").AutoFit
    objExcel.Visible = True
End Sub

Net net of all this is that the issue has to be with the recordset object.

[SeanK]

Ok, here is something wierd.

Given your last comment about the recordset, I went into my sub, put break immediately on the .Open statement, and a debug.print right above that. My intention was to post back the actual query.

However, as soon as I run the sub, it immediately jumps to the Method or Data Element Not Found and highlights .Offset

My query isn't even getting run.

I even put a break on the Private Sub line, but it did not stop. It went straight to the error message.

[DKenny]

Change

rngRowStart.Offset(0, 0).Value = adoRS(5)

to

Debug.Print adoRS(5)

And lets see if that line throws an error, this will confirm that the issue is with the recordset.

[SeanK]

Change

rngRowStart.Offset(0, 0).Value = adoRS(5)

to

Debug.Print adoRS(5)

And lets see if that line throws an error, this will confirm that the issue is with the recordset.

I did this, and again, immediately it went straight to the offset error, but on the next line, and there was nothing in the immediate window, which means Debug.Print adors(5) never ran.

[DKenny]

That is so weird

OK, lets try a different approach.
Delcare a long variable lets call it lRowNum and before we set the rngRowStart we will set this to the value 7.
Now we can change rngRowStart to reference the entire set of cells on the row that need to be updated.
Within the loop we will refer to each cell by using the .cells property of the range object.
Still within the loop we can increment lRowNum and reset the rngRowStart object

here's a revised code snippet.

lRowNum = 7
    
    With shWorkSheet
        Set rngRowStart = .Range(.Cells(lRowNum, 1), .Cells(lRowNum, 7))
    End With
    
        'Start of recordset
        adoRS.MoveFirst
        Do
            'Place each element in the coresponding column
            rngRowStart.Cells(1).Value = adoRS(5) 
            rngRowStart.Cells(2).Value = adoRS(2)
            rngRowStart.Cells(3).Value = adoRS(9)
            rngRowStart.Cells(4).Value = adoRS(11)
            rngRowStart.Cells(5).Value = adoRS(3)
            rngRowStart.Cells(6).Value = adoRS(4)
            rngRowStart.Cells(7).Value = adoRS(10)
        
            'Next Record
            adoRS.MoveNext
            
            'Next Row
            lRowNum = lRowNum + 1
            
            With shWorkSheet
                Set rngRowStart = .Range(.Cells(lRowNum, 1), .Cells(lRowNum, 7))
            End With
        
        Loop Until .EOF

[SeanK]

Now the invalid method is .Value

I backspaced .Value off of rngRowStart.Cells(1) and then put in a . so I would get the drop down intellisense, and Value is not listed. In fact, the only thing beginning with V is VerticalAlignment.

[si_the_geek]

which means Debug.Print adors(5) never ran.

maybe not - perhaps the value of that field is Null, or an empty string (I haven't read enough of the thread to know ).

Try adding a breakpoint to the Debug line, and add a watch of adors(5) ... then see what it contains (especially for the Value property).

[DKenny]

I think I got it. We didn't specify that rngRowStart was an Excel range.
Change

Dim rngRowStart As Range

to

Dim rngRowStart As Excel.Range

If this works then either the .offset approach or the total range approach should work.

[SeanK]

The Excel.Range did it!

Now, the .Offset thing works just fine. I have some formatting issues (my columns don't line up properly) but I can handle that. The important this is that I'm getting all my data.

Thank you SIR!!!!!!!!!!!!!!!!!!

[DKenny]

I can't believe it took me that long. I was writing VBA in Excel so the full qualification of the object was not required. I'm just glad we finally got it working.