Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
MaxRows 65536 in a sheet - A Code Snippet
Hi Everybody,
Just a code snippet to handle the MaxRows (65536) in a sheet while copying a recordset object on to a workbook. It dynamically adds a sheet if required to handle any number of rows Its just that I have been researching this problem (not a bug :-) ) for some time, I thought some one might need a reference. Thanks Ravee. '------------------------------------- Sub ExcelExport() Dim sFileName As String Dim lRow As Long Dim lCol As Long Dim lPage As Long Dim lFields As Long Dim lRecs As Long Dim lMaxRow As Long Dim oField As Object Dim iScale As Integer Dim sScale As String Dim sOutputType As Integer Dim vArray As Variant Dim vBookmark As Variant On Error GoTo Err_Handl lMaxRow = 65535 ' Choose a output type here sOutputType = -4346 'defaults to .xls sFileName = "C:\TEMP\" On Error Resume Next Set oXl = GetObject(, "Excel.Application") 'look for a running copy of Excel If Err.Number < 0 Then 'If Excel is not running then ' Set oXl = CreateObject("Excel.Application") 'run it Set oXl = New Excel.Application 'run it End If On Error GoTo Err_Handl: oXl.DisplayAlerts = False Set oXLWrkBk = oXl.Workbooks.Add Set oXlSheet = oXLWrkBk.ActiveSheet If oRS.RecordCount lMaxRow Then lPage = 1 oRS.MoveFirst While oRS.EOF = False vBookmark = oRS.Bookmark vArray = oRS.GetRows(lMaxRow, vBookmark) If lPage oXLWrkBk.Sheets.Count Then 'Set oXlSheet = oXLWrkBk.Sheets.Add(After:= (lPage - 1), Type:=xlWorksheet) oXLWrkBk.Sheets.Add After:=oXLWrkBk.Worksheets(oXLWrkBk.Sheets.Count), Type:=xlWorksheet End If Set oXlSheet = oXLWrkBk.Sheets(lPage) oXlSheet.Activate lCol = 1 For Each oField In oRS.Fields oXlSheet.Columns(lCol).Select Select Case oField.Type Case adInteger, adSmallInt, adBigInt, adTinyInt, adUnsignedBigInt, _ adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt oXl.Selection.NumberFormat = "#,##0" Case adCurrency oXl.Selection.NumberFormat = "$#,###,##0.00" Case adDate, adDBTimeStamp, adDBDate, adDBTime oXl.Selection.NumberFormat = "mm/dd/yyyy hh:mm AM/PM" Case adDecimal, adNumeric, adDouble, adSingle sScale = "#,##0." If oField.NumericScale 0 Then For iScale = 1 To oField.NumericScale sScale = sScale & "0" Next Else sScale = "#,##0" End If oXl.Selection.NumberFormat = sScale Case Else oXl.Selection.NumberFormat = "@" oXl.Selection.HorizontalAlignment = xlLeft End Select oXlSheet.Cells(1, lCol).Value = oField.Name oXlSheet.Cells(1, lCol).Font.Bold = True lCol = lCol + 1 Next oField lFields = oRS.Fields.Count lRecs = UBound(vArray, 2) + 1 '+ 1 since 0- based array For lCol = 0 To lFields - 1 For lRow = 0 To lRecs - 1 If IsDate(vArray(lCol, lRow)) Then ' Take care of Date fields vArray(lCol, lRow) = Format(vArray (lCol, lRow)) ElseIf IsArray(vArray(lCol, lRow)) Then ' Take care of OLE object fields or array fields vArray(lCol, lRow) = "Array Field" End If Next lRow 'next record Next lCol 'next field oXlSheet.Cells(2, 1).Resize(lRecs, lFields).Value = TransposeDim(vArray) 'For each sheet oXl.Selection.CurrentRegion.AutoFilter oXl.Selection.CurrentRegion.Columns.AutoFit oXl.Selection.CurrentRegion.Rows.AutoFit lPage = lPage + 1 Wend 'While oRS.EOF = True Else 'If oRS.RecordCount 65535 Then ' Meant to work in Excel 2000; use the above logic for older versions oXlSheet.Range("A2").CopyFromRecordset oRS End If 'If oRS.RecordCount 65535 Then oXLWrkBk.Sheets(1).Activate Set oXlSheet = oXLWrkBk.ActiveSheet oXlSheet.Cells(1, 1).Select oXlSheet.SaveAs sFileName, sOutputType oXlSheet.Application.Quit DoEvents GoTo Exit_Handl: Err_Handl: MsgBox Err.Description Exit_Handl: oXlSheet.Application.Quit Set oField = Nothing Set oXlSheet = Nothing Set oXLWrkBk = Nothing Set oXl = Nothing End Sub Function TransposeDim(v As Variant) As Variant ' Custom Function to Transpose a 0-based array (v) Dim X As Long, Y As Long, Xupper As Long, Yupper As Long Dim tempArray As Variant Xupper = UBound(v, 2) Yupper = UBound(v, 1) ReDim tempArray(Xupper, Yupper) For X = 0 To Xupper For Y = 0 To Yupper tempArray(X, Y) = v(Y, X) Next Y Next X TransposeDim = tempArray End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to VLOOKUP multiple sheets and each sheet have 65536 rows? | Excel Worksheet Functions | |||
Excel spread sheet larger than 65536 records | Excel Discussion (Misc queries) | |||
Can I put more than 65536 rows in one Excel sheet? | Excel Worksheet Functions | |||
More than 65536 to new sheet | Excel Worksheet Functions |