Exporting to Excel from Access - runs out of rows 1

[pduncan]

I am using Access and Excel 2002 - trying to export a table to an excel ss by using

DoCmd.RunSQL "UPDATE tblMaintenanceHistory SET tblMaintenanceHistory.MaintenanceDate = Date() where MaintenanceDescription = ""Export Regional Price List"";", 0

but when I do, access reports an error message saying too many lines - the only thing is that I am only exporting 18,340 records. Any ideas?

 

[cLFlaVA]

I'm not sure I follow. An UPDATE query doesn't return any rows.

*cLFlaVA
----------------------------
Lois: "Peter, you're drunk!"
Peter: "I'm not drunk, I'm just exhausted from stayin' up all night drinking!

 

[glab]

Hi guys,
I didn't think that the question I posted a long time ago would be of any interest to anybody. Anyway, if you ARE interested, I have this problem solved. Here's the code that works for me just fine:
---------------------------------

[b]
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
Dim ofld As ADOX.Column
Dim savePath As String

Private Sub cmbTbl_Click()
 Set otbl = ocat.Tables(cmbTbl.Text)
 For Each ofld In otbl.Columns
  LVW.ListItems.Add , , ofld.Name
 Next
End Sub

Private Sub cmdExit_Click()
 End
End Sub

Private Sub cmdStart1_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
 Dim fldCount as Integer
 
  
 Set wbk = xsl.Workbooks.Add
 xsl.Visible = True
 
 strsql = "Select * from [" & cmbTbl.Text & "];"
 Set ors = oconn.Execute(strsql)
 recCount = 0
 Do While Not ors.EOF
  If ors.EOF Then Exit Do
  recCount = recCount + 1
  ors.MoveNext
 Loop
 pgCount = Fix(recCount / 65536) + 1
 If pgCount > 3 Then
  For i = 1 To pgCount - 3
   wbk.Worksheets.Add after:=wbk.Worksheets(Worksheets.Count)
  Next
 End If
 ors.MoveFirst
 For pg = 1 To pgCount
  If pg > pgCount Then Exit For
  Set wsh = wbk.Worksheets(pg)
  wsh.Activate
  For fldCount = 0 to ors.Fields.Count - 1
   wsh.Cells(1,fldCount+1) = ors.Fields(fldCount).Name
  Next
  wsh.Range("A2").[red]CopyFromRecordset ors[/red]
  Set wsh = Nothing
 Next

 
 ors.Close
 Set ors = Nothing
 wbk.Close True, "C:\Test.xls"
 Set wbk = Nothing
 xsl.Quit
 Set xsl = Nothing
 
 MsgBox "Done." & vbCrLf & "Records inserted: " & recCount, vbExclamation, "Finished processing..."

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

 CDL.Filter = "Excel Files (*.xls)|*.xls"
 CDL.DialogTitle = "Select name for the file..."
 CDL.ShowSave
 savePath = CDL.FileName

 strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strdb & ";Persist Security Info=False"
 oconn.Open strconn
 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


err_handle:
If Err.Number <> 0 Then
 If Err.Number = cdlCancel Then
  Err.Clear
  MsgBox "Program will terminate.", vbOKOnly, "Exit program"
  Unload Me
  'Resume
 Else
  MsgBox Err.Description
  Resume
 End If
End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 If oconn.State = 1 Then
  oconn.Close
  Set oconn = Nothing
 End If
 Set otbl = Nothing
 Set ocat = Nothing
End Sub
[/b]

Hope this helps.

 

[ribhead]

pduncan I'm not sure if this is what you want but this is what I use when I send info from Access to XL.

Sub Get_Info()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strdb As String
Dim r As Long
Dim c As Long
Dim fld As Field
r = 1
c = 1
strdb = "location of youtable"
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strdb & ";"
strSQL = "SELECT * FROM tblmytable;"
Set rst = cnt.Execute(strSQL)
rst.MoveFirst
Do While Not rst.EOF And Not rst.BOF
For Each fld In rst.Fields
Cells(r, c) = fld
c = c + 1
Next fld
rst.MoveNext
c = 1
r = r + 1
Loop

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.

 

[xlbo]

Hey ribhead - the previous post (above yours) answers your most recent question

pduncan - that is because M$ have STILL not updated the row limit that Access THINKS excel has - they are still working on the basis that xl95 had only apprx 16000 records - that internal limit has just not been updated (not sure if they've finally done it in 2003)

You can utilise bits from either glab or ribhead's post to get round this

Rgds, Geoff

"Having been erased. the document thjat you are seeking. Must now be retyped"

Please read FAQ222-2244 before you ask a question