export to multiple Excel worksheets

[rib742]

I've reviewed the multiple posts on this but nothing applies.

I once was able to export an Access Table with over 100K lines of data and it would be spanned over multiple worksheets automatically; no special coding. I haven't had to do it in a while and can't seem to find how to.

I know that it's not desireable but this is how the requestor wants the data.

 

[SeeThru]

To use a worksheet tab (office97 at least) change the query to the name of the worksheet you want. Then use the ExportExcel to export, and give it a file name.

If you then export another table/query, use the same file name, and as long as the table or query name is different, it will add a new worksheet.

Note you can use code to dynamically change the name of the query as you run it, so you can re-use the same query repeatedly.

SeeThru
Synergy Connections Ltd - Telemarketing Services

 

[rib742]

Thanks but what I need is for the following to hapopen and I cannot find how to do it but remember it can be done.

Export a table in Access that has 140K rows. During the one time export, the first 65xxx rows are put on tab 1, then the next 65xxx rows are put on tab 2, etc until all the rows are exported. All in one shot.

 

[SeeThru]

You just need to loop in code.

Create a query that selects all records. If you have sequential ID's this would be easiest.

Rename the query to 'tab1'
Modify the querydef with a calculated where that seects the first x records.
Open query, export to excel

Rename as Tab2 and continue

if you had sequential IDs...
some pseudo code

dim idstart as long

do while idstart<mytable.recordsetclone.recordcount
'rename query to 'tab1'
'open querydef and add where....
qrydef=qrydef & " WHERE contactdID Between " & idstart * " and " * idstart+65000
docmd.exportquery "tab1" filename
rename 'tab1' back to a normal name
idstart=idstart+6500
loop


SeeThru
Synergy Connections Ltd - Telemarketing Services

 

[CautionMP]

rib742,
Here's a concept. I used the [tt]TransferSpreadsheet()[/tt] arguments as a starting point and added minimal exception handling.

Usage:

[tab][tt]TransferMultipleSpreadsheet "tblPODetail", "C:\PODetail.xls", True[/tt]

Public Sub TransferMultipleSpreadsheet(TableName As String, FileName As String, Optional HasFieldNames As Boolean = False)
  Const strcDataSheetPrefix As String = "Data"
  Dim objExcel As Object
  Dim objWorkbook As Object
  Dim objWorksheet As Object
  Dim objRange As Object
  Dim rstData As DAO.Recordset
  Dim lngRows As Long, lngSheets As Long
  Dim lngCounter As Long
  
  'Open the source recordset and check for records
  Set rstData = CurrentDb.OpenRecordset(TableName, dbOpenForwardOnly)
  If rstData.BOF Then
    MsgBox "There are no records to export", vbCritical, "TransferMultipleSpreadsheet"
    GoTo TransferMultipleSpreadsheet_Exit
  End If
  'END Open the source recordset

  Set objExcel = CreateObject("Excel.Application")
  objExcel.Visible = True
  Set objWorkbook = objExcel.Workbooks.Add
  
  'Delete the default worksheets leaving only one, which we grab
  On Error Resume Next
  objExcel.DisplayAlerts = False
  For Each objWorksheet In objWorkbook.worksheets
    objWorksheet.Delete
  Next objWorksheet
  objExcel.DisplayAlerts = False
  On Error GoTo 0
  Set objWorksheet = objWorkbook.worksheets(1)
  'END Delete the default worksheets leaving only one, which we grab
      
  Do
    'Check if a new worksheet needs to be added and rename
    If objWorksheet Is Nothing Then
      Set objWorksheet = objWorkbook.worksheets.Add
    End If
    lngSheets = lngSheets + 1
    objWorksheet.Name = strcDataSheetPrefix & Format$(lngSheets, "00")
    'END Check if a new worksheet needs to be added and rename
    
    'Write the field names and determine where to output data & _
    and how many rows.
    If HasFieldNames Then
      For lngCounter = 0 To rstData.Fields.Count - 1
        objWorksheet.Cells(1, lngCounter + 1) = rstData.Fields(lngCounter).Name
      Next lngCounter
      Set objRange = objWorksheet.Range("A2")
      lngRows = 65535
    Else
      objRange = objWorksheet.Range("A1")
      lngRows = 65536
    End If
    'END Write the field names ...
    
    'Output the data, CopyFromRecordset moves the cursor in rstData after copy
    objRange.CopyFromRecordset rstData, lngRows
    DoEvents
    'END Output the data...
    
    'This will tell the loop to create a new worksheet
    Set objWorksheet = Nothing
  Loop Until rstData.EOF
  
TransferMultipleSpreadsheet_Exit:
  On Error Resume Next
  rstData.Close
  Set rstData = Nothing
  Set objRange = Nothing
  objWorkbook.SaveAs FileName
  objWorkbook.Close
  Set objWorkbook = Nothing
  objExcel.Quit
  Set objExcel = Nothing
End Sub

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)

 

[SkipVought]

" export an Access Table with over 100K lines of data "

Why EXPORT an entire table???

I regularly QUERY Access, Oracle, DB2 tables with hundreds of thousands of rows of data, from Excel, but I return ONLY the data I need.

Why would you replicate a table multiple times?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[rib742]

From my original post -- "I know that it's not desireable but this is how the requestor wants the data."

I work with d/b's all the time and routinely pull back hundres of thousands of records daily and only export what I need. However, the requestor is adament that they get all the data in Excel. I warned them so it's their issue to deal with after the fact.

Thanks for the other posts but what I did in the past inmvolved no coding.

 

[fabc]

I am trying CautionMP's script but it stops at
Dim rstData As DAO.Recordset
I changed it to Dim rstData As Recordset

and then it stops at
Set rstData = CurrentDb.openRecordset(TableName, dbOpenForwardOnly)

What am I suppose to do to resolve this?

Fabc

 

[CautionMP]

add a reference to the Microsoft DAO 3.6 Object Library