Access Data into Excel

[JohnAcc]

Hi There,

I have some data in an access database that i am importing into excel with the following code. My problem is that there are more than 65536 records. How do i get excel to continue importing the data onto a new worksheet ?

Sub GetEnquiryTable()
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Integer
Dim Path As String
Set Ws = Sheets("Sheet1&quot
Path = "C:\Database Files\Enquiry Table.mdb"
Ws.Range("A1&quot.CurrentRegion.ClearContents
Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
Set Rs = Db.OpenRecordset("Enquiry Table&quot
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
Ws.Range("A2&quot.CopyFromRecordset Rs
Ws.Range("A1&quot.CurrentRegion.Columns.AutoFit
Rs.Close
Db.Close
End Sub

Any help would be appreciated.

Rgds, John

 

[ITMannie]

John

I guess you'll just have to extract the data from Access row by row and keep a count of the number of rows you are importing. When you reach the limit of an Excel sheet, just create another worksheet and assign it to your worksheet variable.

Your code would look something like this (I haven't tested this - I'm just writing it off the top of my head)

'=====================
Sub GetEnquiryTable()
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Integer
Dim Path As String
Dim RowCount As Long

Set Ws = Sheets("Sheet1&quot
Path = "C:\Database Files\Enquiry Table.mdb"
Ws.Range("A1&quot.CurrentRegion.ClearContents
Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
Set Rs = Db.OpenRecordset("Enquiry Table&quot

RowCount = 2

Do While Not Rs.EOF

For i = 0 To Rs.Fields.Count - 1
Ws.Cells(RowCount, i + 1).Value = Rs.Fields(i)
Next i

Rs.MoveNext

If RowCount = 65536 Then
'add the headings and do a bit of formatting
'before we move onto a new sheet
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i

Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
Ws.Range("A1&quot.CurrentRegion.Columns.AutoFit

'start a new sheet and reset the counter
Set Ws = Worksheets.Add
RowCount = 2
End If
Loop

Rs.Close
Db.Close
End Sub

'=====================

You get the idea - I'll leave it for you to test and tidy up a bit.

cheers

Iain

 

[SkipVought]

John,

One of the ideas about having a database is that you need only extract the data you need for a particular set of parameters.

You ususlly don't need to extract that much data.

If you do, you should not be using Excel as your tool.

What are you trying to do?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ITMannie]

Good point Skip. I forgot to mention in my last post that it would be unusual to reach that row limit in Excel.

Cheers

Iain