Eksportere query til excel +65K raekker

Det må være muligt at gå ind i en løkke således:

Dim VARa As LONG
VARa = 0
Do Until VARa = 65000
din eksportkommando
Me.felt1 = True
VARa = VARa + 1
Loop

Du skal også sikre dig, at du opretter et felt i tabellen der angiver, om åpsten er eksporteret, og så sætte et kriterie i forespørgslen der markerer, at posten er eksporteret. Her felt1.

Make a number of queries which limits the number of rows to 65K and then export each one seperatly.

DoCmd.TransferSpreadsheet acExport, 8, "Qry_1",
"C:\\Export\Query_1.xls", False, "Qry_1"

DoCmd.TransferSpreadsheet acExport, 8, "Qry_2",
"C:\\Export\Query_1.xls", False, "Qry_2"

DoCmd.TransferSpreadsheet acExport, 8, "Qry_3",
"C:\\Export\Query_1.xls", False, "Qry_3"

problemet med din loesning, terry, er at jeg kan ikke forudsige antallet af records, men jeg kan bruge metoden med flere ark - tror jeg :-)
mugs, ja, ikke uenig, men ikke helt sikker paa hvordan jeg kan loese det problem. Mine VBA evner er mest til copy/paste, og saa en lille smule tilretning ;-)

Hvis en er jer har tid/lyst, vil jeg gerne sende databasen...

mugs snabelting mail.dk

Husk at sende som .zip fil

Okay, er kommet lidt videre. Har fundet foelgende kode fra http://bytes.com/forum/thread470687.html og modificeret det lidt saa det passer - kun navne paa queries.
Men jeg faar foelgende fejl:
Runtime error 3011
The Microsoft Jet Database couldn't find the object Export1...
og den "breaker" ved
"Set myXLRst = myXLDB.OpenRecordset(strSheetName)" i funktionen naar jeg vaelger debug.

Kan en med erfarne oejne se hvad der gaar galt, eller er der for meget at kigge igennem?

takker

---------
Function ExportToExcel(strFileName As String, _
strSheetName As String, _
strSourceName As String, _
Optional bolMsgBoxWhenDone _
As Boolean = False) _
As Long

' strFileName is the Excel File to Create (or use)
' strSheetName is the sheet within the Excel file to create
' strSourceName is the table, query, or SQL string
' to use as the source
' bolMsgBoxWhenDone: Want a msgbox saying "Done"?

Dim myXLDB As DAO.Database
Dim myXLTDF As DAO.TableDef
Dim myXLRst As DAO.Recordset
Dim myDB As DAO.Database
Dim myRst As DAO.Recordset
Dim i As Long
Dim lngRC As Long
Dim lngStatus As Long
Dim varStatus As Variant

'Excel 2000
Set myXLDB = DBEngine.OpenDatabase(strFileName, dbDriverNoPrompt, False, "Excel 8.0")

'Excel 97
'Set myXLDB = DBEngine.OpenDatabase(strFileName, dbDriverNoPrompt, False, "Excel 7.0")

Set myDB = CurrentDb
Set myRst = myDB.OpenRecordset(strSourceName)

Set myXLTDF = myXLDB.CreateTableDef(strSheetName)
For i = 0 To myRst.Fields.Count - 1
With myXLTDF
Select Case myRst.Fields(i).Properties("Type")
Case 1
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbBoolean)
Case 2
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbByte)
Case 3
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbInteger)
Case 4
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbLong)
Case 5
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbCurrency)
Case 6
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbSingle)
Case 7
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbDouble)
Case 8
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbDate)
Case 9
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbBinary)
Case 10
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbText)
Case 11
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbLongBinary)
Case 12
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbMemo)
Case 13, 14
' unknown field types.
' No idea what these are!
Case 15
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbGUID)
Case 16
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbBigInt)
Case 17
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbVarBinary)
Case 18
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbChar)
Case 19
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbNumeric)
Case 20
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbDecimal)
Case 21
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbFloat)
Case 22
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbTime)
Case 23
.Fields.Append .CreateField( _
myRst.Fields(i).Name, _
dbTimeStamp)
End Select
End With
Next i
'myXLDB.TableDefs.Append myXLTDF
Set myXLTDF = Nothing
myXLDB.TableDefs.Refresh

Set myXLRst = myXLDB.OpenRecordset(strSheetName)
myRst.MoveLast
lngRC = myRst.RecordCount

varStatus = SysCmd(acSysCmdInitMeter, "Exporting Records", lngRC)
lngStatus = 1
varStatus = SysCmd(acSysCmdUpdateMeter, lngStatus)

myRst.MoveFirst
While Not myRst.EOF
lngStatus = lngStatus + 1
varStatus = SysCmd(acSysCmdUpdateMeter, lngStatus)
myXLRst.AddNew
For i = 0 To myRst.Fields.Count - 1
myXLRst.Fields(i) = Nz(myRst.Fields(i))
Next i
myXLRst.Update
myRst.MoveNext
Wend
varStatus = SysCmd(acSysCmdRemoveMeter)
myXLRst.Close
Set myXLRst = Nothing
ExportToExcel = myRst.RecordCount
myRst.Close
Set myRst = Nothing
myDB.Close
Set myDB = Nothing
myXLDB.Close
Set myXLDB = Nothing
If bolMsgBoxWhenDone = True Then
MsgBox "Done!", _
vbInformation + vbOKOnly, _
"Export To Excel"
End If
End Function

---------------

Private Sub cmdTest_Click()
Dim i As Integer
Dim x As Integer
Dim lngTotalRecords As Long
Dim intLoops As Integer
Dim strFileName As String
Dim strSheetName As String
Dim strSQL As String
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim what As String

'name of spreadsheet to create (change to suit)
strFileName = "C:\test.xls"
Set db = CurrentDb()
what = "qry_test"
'how many records do we have
strSQL = "SELECT Count(ID) AS TotalRecords FROM qry_test;"
Set rst = db.OpenRecordset(strSQL)
With rst
If .RecordCount <> 0 Then
.MoveFirst
lngTotalRecords = !TotalRecords
Else
lngTotalRecords = 0
End If
.Close
End With
MsgBox lngTotalRecords
Set rst = Nothing

'calc number of spreadsheets required
If lngTotalRecords Mod 65000 = 0 Then
intLoops = lngTotalRecords / 65000
Else
intLoops = (lngTotalRecords \ 65000) + 1
End If

'clear temp table
strSQL = "DELETE * FROM tblCheck;"
db.Execute strSQL, dbFailOnError

For i = 1 To intLoops
x = x + 1
'create spreadsheet
strSheetName = "Export" & x
Call ExportToExcel(strFileName, strSheetName, "qryExportdata", False)

'write exported IDs to tblCheck
strSQL = "INSERT INTO tblCheck (ID) SELECT ID FROM qry_exportdata;"
db.Execute strSQL, dbFailOnError
Next i

Set rst = Nothing
Set db = Nothing
End Sub

Mail sent til mugs...

if you cant getit to work then you can send me your dB and I'll see what I can do when I get time.
ekspertenATsanthell.dk

AT = @

Beklager, havde glemt den var aaben!!

Tak for point - Men blev problemet løst og i givet fald hvordan?

excel 2007 med 1024k raekker var nok :-)
Men jeg fik noget kode som gav et ret godt resultat! Hvis du gerne vil ha en kopi, saa sig til!

OK - Nej ingen kode, beskæftiger mig ikke med 2007

Koden var til Access 97, og virkede fint der.