CopyFromRecordset method doesn't work as it should... 1

[glab]

Hello everyone,

I'm trying to write a piece of code, which would dump over 65536 records from Access database into Excel spreadsheet. Actually, I've got already couple of versions of this code working. But I can't get to work the most attractive one - using CopyFromRecordset method. In the Visual Studio help on this method there's a statement - [red]"Copying begins at the current row of the Recordset object"[/red]. So, whenever 65536 records have been copied, I move the current position of the recordset to the current position + 65536 and repeat CopyFromRecordset operation. I know, that recordset did move there, but when I check just copied data, it's like it never did and copying started again from the first record.

So, what do you think might be the problem?

Thank you.

 

[fredericofonseca]

Don't know how you have your code, but the following works fine with Excel 2003/SQL server 2000.
Table with 200000 records.
No need to reposition.

Option Explicit
Sub aa()
Dim dbconnstring As String
Dim DBConn As ADODB.Connection
Dim RS As ADODB.Recordset
Dim sSql As String
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim I As Long
Set ws = Workbooks("demoload.xls").Worksheets(1)
Set ws1 = Workbooks("demoload.xls").Worksheets(2)
Set ws2 = Workbooks("demoload.xls").Worksheets(3)
Set ws3 = Workbooks("demoload.xls").Worksheets(4)
Set DBConn = New ADODB.Connection
Set RS = New Recordset
dbconnstring = "dsn=LocalServer;uid=usexr;pwd=pwdx;database=databasex;"
DBConn.CursorLocation = adUseClient
DBConn.Open dbconnstring

sSql = "select cast(pais as char) from democount"

RS.Open sSql, DBConn, adOpenStatic, adLockOptimistic

ws.Range("a100").CopyFromRecordset RS
ws1.Range("a100").CopyFromRecordset RS
ws2.Range("a1000").CopyFromRecordset RS
ws3.Range("a1000").CopyFromRecordset RS

End Sub

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[glab]

Frederico,
Thank you for your response. Sorry for posting my question twice. It's just there was no replies in one of them for a long time, so I decided to increase my chances by posting it again.
Anyway, from your code I didn't see how is the data in worksheet ws supposed to be different from the data in worksheet ws1 and so on. Probably inner workings of Excel2003/SQL Server combination. I have Excel2000/Access2000 and this hookup doesn't really do the
trick. Or, which is quite possible, something wrong with my code. Below, please find couple of procedures: for Start button - with repositioning; for Start1 button - without repositioning. I hope you'll notice something, that doesn't let it do the work.
Thank you in advance

-----------------------------------------------
Option Explicit
Dim oconn As New ADODB.Connection
Dim strconn As String
Dim ors As ADODB.Recordset
Dim strsql As String
Dim fso As New Scripting.FileSystemObject
Dim strdb As String
Dim ocat As New ADOX.Catalog
Dim otbl As ADOX.Table

Private Sub cmdStart_Click()
Dim pg As Long
Dim pgCount As Long
Dim rec As Long
Dim recCount As Long
Dim xsl As New Excel.Application
Dim wbk As Excel.Workbook
Dim wsh As Excel.Worksheet
Dim lastPage As Boolean
Dim i As Integer

Set wbk = xsl.Workbooks.Add
xsl.Visible = True

strsql = "Select * from [" & cmbTbl.Text & "];"
Set ors = oconn.Execute(strsql)
ors.PageSize = 65536
pgCount = ors.PageCount
recCount = ors.RecordCount
If pgCount > 3 Then
For i = 1 To pgCount - 3
wbk.Worksheets.Add after:=wbk.Worksheets(Worksheets.Count)
Next
End If

' For pg = 1 To pgCount
' ors.AbsolutePage = pg
' Set wsh = wbk.Worksheets(pg)
' wsh.Activate
' wsh.Cells(1, 1).CopyFromRecordset ors
' Next
rec = 1
Do While Not (ors.AbsolutePosition + 65536) > recCount
Set wsh = wbk.Worksheets(rec)
wsh.Activate
If rec = 1 Then
wsh.Range("A1").CopyFromRecordset ors
Else
If (ors.AbsolutePosition + 65536) < recCount Then
wsh.Range("A1").CopyFromRecordset ors
lastPage = False
Else
lastPage = True
End If
If lastPage = True Then Exit Do
End If
rec = rec + 1
ors.AbsolutePosition = ors.AbsolutePosition + 65536
Loop

ors.Close
Set ors = Nothing
wbk.Close True, "C:\Test.xls"
Set wbk = Nothing
xsl.Quit
Set xsl = Nothing

End Sub

Private Sub Start1_Click()
Dim pg As Long
Dim pgCount As Long
Dim rec As Long
Dim recCount As Long
Dim xsl As New Excel.Application
Dim wbk As Excel.Workbook
Dim wsh As Excel.Worksheet
Dim lastPage As Boolean
Dim i As Integer

Set wbk = xsl.Workbooks.Add
xsl.Visible = True

strsql = "Select * from [" & cmbTbl.Text & "];"
Set ors = oconn.Execute(strsql)
ors.PageSize = 65536
pgCount = ors.PageCount
recCount = ors.RecordCount
If pgCount > 3 Then
For i = 1 To pgCount - 3
wbk.Worksheets.Add after:=wbk.Worksheets(Worksheets.Count)
Next
End If
For pg = 1 To pgCount
If pg > pgCount Then Exit For
Set wsh = wbk.Worksheets(pg)
wsh.Activate
wsh.Range("A1").CopyFromRecordset ors
Set wsh = Nothing
Next


ors.Close
Set ors = Nothing
wbk.Close True, "C:\Test.xls"
Set wbk = Nothing
xsl.Quit
Set xsl = Nothing

End Sub

Private Sub Form_Load()

On Error GoTo err_handle
CDL.CancelError = True
CDL.Filter = "Access Files (*.mdb)|*.mdb"
CDL.ShowOpen
strdb = CDL.FileName
strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strdb & ";Persist Security Info=False"
oconn.Open strconn
oconn.CursorLocation = adUseClient
Set ocat.ActiveConnection = oconn
For Each otbl In ocat.Tables
If InStr(1, otbl.Name, "msys", vbTextCompare) = 0 Then
cmbTbl.AddItem otbl.Name
End If
Next

Set ocat = Nothing
err_handle:
If Err.Number <> 0 Then
If Err.Number = cdlCancel Then
Err.Clear
Exit Sub
Else
MsgBox Err.Description
Resume
End If
End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
oconn.Close
Set oconn = Nothing
End Sub

 

[fredericofonseca]

As for the data on ws versus ws1 and ws2
ws has rows from 100 to 65436
ws1 has rows from 65436 to 130000 (aprox)
ws2 has rows from 130000 to 195000 (aprox)


As for your code try the following.
Assumes your table has more than 130000 rows.
I did not try it yet with 2000, but will do later.


Private Sub Start1_Click()
Dim xsl As New Excel.Application
Dim wbk As Excel.Workbook
Dim wsh1 As Excel.Worksheet
Dim wsh2 As Excel.Worksheet
Dim wsh3 As Excel.Worksheet

Set wbk = xsl.Workbooks.Add
xsl.Visible = True

strsql = "Select * from [" & cmbTbl.Text & "];"

ors.Open strsql, oconn, adOpenStatic, adLockOptimistic

Set wsh1 = wbk.Worksheets(1)
wsh1.Range("A1").CopyFromRecordset ors

Set wsh2 = wbk.Worksheets(2)
wsh2.Range("A1").CopyFromRecordset ors

Set wsh3 = wbk.Worksheets(3)
wsh3.Range("A1").CopyFromRecordset ors

ors.Close
Set ors = Nothing
wbk.Close True, "C:\Test.xls"
Set wbk = Nothing
xsl.Quit
Set xsl = Nothing

End Sub

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[glab]

Frederico,
Sorry I'm late with my responses - probably time difference. I just got to work. Thanks again that you haven't given up on me. Just couple more questions:
1. This part in your code:

ws.Range[red]("a100")[/red].CopyFromRecordset RS
ws1.Range[red]("a100")[/red].CopyFromRecordset RS
ws2.Range[red]("a1000")[/red].CopyFromRecordset RS
ws3.Range[red]("a1000")[/red].CopyFromRecordset RS

I'm not dealing a lot with Excel so please bear with me. Is it that part in red, that really does the trick? 'cause I didn't quite get changing Range("a100") to Range("a1000"). Does it have special meaning as far as Excel is concerned? Because to me it's just a cell on worksheet - column "A" and row 100 or 1000 respectively.

2. About your suggestion. I'll give it a try, but I'd rather write something more generic since I don't know in advance how many records there going to be and hence, how many worksheets - and object variables for each one of them - I will have to add and declare. What do you think?

Meantime, I will try it on the machine, which has Excel 2003 installed. Could be the reason for malfunctioning.

Best regards.
Thank you.

Sergey.

 

[fredericofonseca]

The a100 or a1000 is just to show that you can move it to a different destination.
It could be A1 as far as you are concerned,l so NO it is not what does the trick.

My code is just to see if it works.

If it does then it is something wrong with your code, and it is therefore easier to find the problem.

If it does not then we will need to dig further.

DO try it as I asked, just to see if it works or not.

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[glab]

Hey Frederico,

I did try your version and unfortunately got the same result - all worksheets contain the same set of data, starting from record 1 to record 65536. Maybe it's version of Excel, that doesn't work appropriately with this method?
But as far as I remember there was nothing against usage of CopyFromRecordset with any specific version of Excel. I tried the code also with Excel XP - same result.
Well, this could probably become a theme for "Unsolved mysteries". What do you think?

Thank you.

 

[fredericofonseca]

I have just tried with
access 2000
excel 2000
mdb1.mdb table with 196608 records and the following code.
ADO 2.7

Option Explicit
Sub sub1()
Dim strconn As String
Dim oconn As ADODB.Connection
Dim ors As ADODB.Recordset
 Dim xsl As New Excel.Application
 Dim wbk As Excel.Workbook
 Dim wsh1 As Excel.Worksheet
 Dim wsh2 As Excel.Worksheet
 Dim wsh3 As Excel.Worksheet
Dim strsql As String
strconn = "Provider=Microsoft.Jet.OLEDB.4.0;"
strconn = strconn & "Data Source=c:\tmp\db1.mdb;Persist Security Info=False"
Set oconn = New ADODB.Connection
oconn.Open strconn
Set ors = New ADODB.Recordset
 Set wbk = xsl.Workbooks.Add
 xsl.Visible = True
 
 strsql = "Select * from dbo_democount;"

 ors.Open strsql, oconn, adOpenStatic, adLockOptimistic

 Set wsh1 = wbk.Worksheets(1)
 wsh1.Range("A1").CopyFromRecordset ors

 Set wsh2 = wbk.Worksheets(2)
 wsh2.Range("A1").CopyFromRecordset ors

 Set wsh3 = wbk.Worksheets(3)
 wsh3.Range("A1").CopyFromRecordset ors
 
 ors.Close
 Set ors = Nothing
 wbk.Close True, "C:\Test.xls"
 Set wbk = Nothing
 xsl.Quit
 Set xsl = Nothing

End Sub

sheet1 contains records 1 to 65536
sheet2 contains records 65537 to 131072
and sheet3 contains the remaining.

If you copy the above code to a VBA window and run it in isolation it has to work.

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[glab]

Frederico,

I think I finally figured out why it didn't work. I mean, I did try you code as Access Macro and it worked. I thought that the fact, that I actually wrote this piece in VB could be the reason it didn't work. But the code didn't seem any different to me until I noticed the one thing. When I was creating Connection object, I would set CursorLocation to adUseClient in order to use paged recordset. Once I commented it out - even my code worked OK.

Thank you so much for your patience and making me think it through more thorough.

Best regards and have a great day.

Thanks.

 

[fredericofonseca]

Humm.

You are right.
My original code with XL2003 and SQL did work fine with cursortype set to adclient, but not the XL2000 one where I did not define the cursor type.
I have just tried it and with the VBA on excel it doesn't work either.


It is either version of Excel, using SQL or version of MDAC as I was using 2.8 with XL2003. I hate when this happens!!!

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[glab]

Well, what can you do?

I guess, I'll try to check all these assumptions with different versions of Excel, ADO, DAO and so on for later use. And, compiling version, that works now, with references to the appropriate libraries should help, too.

Anyway, thanks a lot for all your help.

Best regards.
Sergey.