Printable View
I have code that creates an Excel spreadsheet from a datatable which works just fine. But the placing of the data on the spreadsheet is slow (about 1 minute for 3,000 records.) It uses a nested loop-thru-the-rows-loop-thru-the-columns, the only way you can do it from a datatable if my understanding is correct. .CopyFromRecordset requires a record set. Is it possible to copy a datatable to a recordset? Or is there another way to speed up the placing of data from VB to Excel?
Does it need to specifically be an Excel file or is a CSV file sufficient? The reason I ask is because when I use either of the two methods found here, it takes a matter of milliseconds to create the file for 3,000 rows with 5 columns.
It must be Excel.
I use code like this to make a s/s
What are you using?
Code:Imports System.Data
Imports System.Data.SqlClient
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Spreadsheet
Public Class SpreadsheetService
Private spreadSheet As SpreadsheetDocument
Private worksheetPart As WorksheetPart
Private Function cellAddr(i As Integer) As String
If i >= 26 Then
Return "A" & Chr(65 + (i - 26))
Else
Return Chr(65 + i)
End If
End Function
Public Function CreateSpreadsheet(filePath As String) As Boolean
Try
spreadSheet = SpreadsheetDocument.Create(filePath, SpreadsheetDocumentType.Workbook)
Dim WorkbookPart As WorkbookPart = spreadSheet.AddWorkbookPart()
Dim wb As Workbook = New Workbook()
Dim ws As Worksheet = New Worksheet()
Dim sd As SheetData = New SheetData()
ws.Append(sd)
spreadSheet.WorkbookPart.Workbook = wb
spreadSheet.WorkbookPart.Workbook.Save()
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function AddSheet(name As String) As String
Dim wsp As WorksheetPart = spreadSheet.WorkbookPart.AddNewPart(Of WorksheetPart)()
wsp.Worksheet = New Worksheet
wsp.Worksheet.AppendChild(New DocumentFormat.OpenXml.Spreadsheet.SheetData)
wsp.Worksheet.Save()
Even if you write each record out via Interop, 3000 records should only take a few seconds. Take a look at this post.
That example uses the Excel.Range.Value2 property that will write any DateTime type as a numeric value. You would need to format the Excel cells as Date then. Alternatively, modify that code to use the Excel.Range.Value property instead.
szlamany, this is the code:
Code:Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim icol As Long, irow As Long
' Create an instance of Excel and add a workbook
xlApp = CreateObject("Excel.Application")
xlWb = xlApp.Workbooks.Add
xlWs = xlWb.Worksheets("Sheet1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
icol = 1
For Each Column As DataColumn In dt.Columns
If Column.ColumnName.ToLower <> "stockitemid" And Column.ColumnName.ToLower <> "pagenum" Then
xlWs.cells(1, icol).value = Column.ColumnName
If Column.ColumnName.ToLower = "comments" Then
xlApp.Columns(icol).Select()
xlApp.Selection.ColumnWidth = 44
xlApp.columns(icol).wraptext = True
End If
icol = icol + 1
End If
Next
xlWs.Rows("1:1").Font.Bold = True
irow = 2 'start with 2nd row
For Each dr As DataRow In dt.Rows
icol = 1
For Each dc As DataColumn In dt.Columns
If dc.ColumnName.ToLower <> "stockitemid" And dc.ColumnName.ToLower <> "pagenum" Then
If dc.ColumnName.ToLower <> "spare" Then
xlWs.cells(irow, icol) = dr(dc.ColumnName)
Else
If CStr(dr(dc.ColumnName)).ToLower <> "false" Then
xlWs.cells(irow, icol) = "Spare"
End If
End If
icol = icol + 1
End If
Next
irow = irow + 1
Next
' Auto-fit the column widths and row heights
xlWs.Select()
xlWs.Columns.AutoFit()
xlWs.Cells(1, 1).select()
' Release Excel references
xlWs = Nothing
xlWb = Nothing
xlApp = Nothing
TnTinMN, the posted code takes about a minute to copy about 3,000 rows.
szlamany,
I'm getting does not contain any public member or cannot be found on
Code:Imports DocumentFormat.OpenXml
I believe that comes from a download of a MS SDK
Search around for: OpenXMLSDKv2
I used this - it was one version back - cannot remember why I did that...
The code you have shown in post #6 is about slowest way you can transfer information to Excel using Interop. Take a look at code I referred you to previously. It greatly reduces the amount of communication needed to transfer the data by sending a complete row in a single statement. You will not be able to use it as direct replacement for your code as you are filtering/modifying the DataTable data as you transfer. You could pre-process your DataTable to make the needed modifications to its values and the use the export method I presented in the referenced posting.Quote:
Originally Posted by projecttoday
Tn, bravo! I got it to work and it's quite fast. Thanks for the link.
szlamany, I never got that downloaded. I may try it tomorrow. Thanks.
In case you do want to try this out - here is the entire class (the MS SDK it uses creates .xlsx files only, from what I know).
And here is how I call it on a AJAX post with a JSON array of record objectsCode:Imports System.Data
Imports System.Data.SqlClient
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Spreadsheet
Public Class SpreadsheetService
Private spreadSheet As SpreadsheetDocument
Private worksheetPart As WorksheetPart
Private Function cellAddr(i As Integer) As String
If i >= 26 Then
Return "A" & Chr(65 + (i - 26))
Else
Return Chr(65 + i)
End If
End Function
Public Function CreateSpreadsheet(filePath As String) As Boolean
Try
spreadSheet = SpreadsheetDocument.Create(filePath, SpreadsheetDocumentType.Workbook)
Dim WorkbookPart As WorkbookPart = spreadSheet.AddWorkbookPart()
Dim wb As Workbook = New Workbook()
Dim ws As Worksheet = New Worksheet()
Dim sd As SheetData = New SheetData()
ws.Append(sd)
spreadSheet.WorkbookPart.Workbook = wb
spreadSheet.WorkbookPart.Workbook.Save()
Catch ex As Exception
Return False
End Try
Return True
End Function
Public Function AddSheet(name As String) As String
Dim wsp As WorksheetPart = spreadSheet.WorkbookPart.AddNewPart(Of WorksheetPart)()
wsp.Worksheet = New Worksheet
wsp.Worksheet.AppendChild(New DocumentFormat.OpenXml.Spreadsheet.SheetData)
wsp.Worksheet.Save()
Dim sheetId As UInt32 = 0
If spreadSheet.WorkbookPart.Workbook.Sheets Is Nothing Then
spreadSheet.WorkbookPart.Workbook.AppendChild(New Sheets())
sheetId = 1
Else
sheetId = Convert.ToUInt32(spreadSheet.WorkbookPart.Workbook.Sheets.Count() + 1)
End If
With spreadSheet.WorkbookPart.Workbook.GetFirstChild(Of Sheets).AppendChild(New DocumentFormat.OpenXml.Spreadsheet.Sheet())
.Id = spreadSheet.WorkbookPart.GetIdOfPart(wsp)
.SheetId = sheetId
.Name = name
End With
spreadSheet.WorkbookPart.Workbook.Save()
WorksheetPart = spreadSheet.WorkbookPart.WorksheetParts(spreadSheet.WorkbookPart.WorksheetParts.Count - 1)
Return spreadSheet.WorkbookPart.GetIdOfPart(wsp)
End Function
Public Function _getWorkSheet(sheetId As String) As Worksheet
Dim wsp As WorksheetPart = DirectCast(spreadSheet.WorkbookPart.GetPartById(sheetId), WorksheetPart)
Return wsp.Worksheet
End Function
Public Sub AddRow(sheetId As String, sdr As SqlDataReader)
Dim sd As SheetData = DirectCast(_getWorkSheet(sheetId).Where(Function(x) x.LocalName = "sheetData").First(), SheetData)
Dim ri As Integer = sd.ChildElements.Count() + 1
Dim header As New Row With {.RowIndex = Convert.ToUInt32(ri)}
sd.Append(header)
For i = 0 To sdr.FieldCount - 1
Dim cv As New CellValue() With {.Text = sdr(i).ToString}
Dim cell1 As Cell = New Cell() With {.CellReference = cellAddr(i) & (ri).ToString, .DataType = CellValues.String, .CellValue = cv}
'cell1.Append(inlineString1)
header.AppendChild(cell1)
Next
_getWorkSheet(sheetId).Save()
End Sub
Private Function GenerateStyleSheet() As Stylesheet
' Index 0 - The default font.
' Index 1 - The bold font.
' Index 2 - The Italic font.
' Index 3 - The Times Roman font. with 16 size
' Index 0 - The default fill.
' Index 1 - The default fill of gray 125 (required)
' Index 2 - The yellow fill.
' Index 0 - The default border.
' Index 1 - Applies a Left, Right, Top, Bottom border to a cell
' Index 0 - The default cell style. If a cell does not have a style index applied it will use this style combination instead
' Index 1 - Bold
' Index 2 - Italic
' Index 3 - Times Roman
' Index 4 - Yellow Fill
' Index 5 - Alignment
' Index 6 - Border
' Index 7 - Numberic #,###.## - EXCEL default style 4
Return New Stylesheet( _
New Fonts(New Font(New FontSize() With {.Val = 11}, New Color() With {.Rgb = New HexBinaryValue() With {.Value = "000000"}}, New FontName() With {.Val = "Calibri"}) _
, New Font(New Bold(), New FontSize() With {.Val = 11}, New Color() With {.Rgb = New HexBinaryValue() With {.Value = "000000"}}, New FontName() With {.Val = "Calibri"}) _
, New Font(New Italic(), New FontSize() With {.Val = 11}, New Color() With {.Rgb = New HexBinaryValue() With {.Value = "000000"}}, New FontName() With {.Val = "Calibri"}) _
, New Font(New FontSize() With {.Val = 16}, New Color() With {.Rgb = New HexBinaryValue() With {.Value = "000000"}}, New FontName() With {.Val = "Times New Roman"})) _
, New Fills(New Fill(New PatternFill() With {.PatternType = PatternValues.None}) _
, New Fill(New PatternFill() With {.PatternType = PatternValues.Gray125}) _
, New Fill(New PatternFill(New ForegroundColor() With {.Rgb = New HexBinaryValue() With {.Value = "FFFFFF00"}}) With {.PatternType = PatternValues.Solid})) _
, New Borders(New Border(New LeftBorder(), New RightBorder(), New TopBorder(), New BottomBorder(), New DiagonalBorder()) _
, New Border(New LeftBorder(New Color() With {.Auto = True}) With {.Style = BorderStyleValues.Thin}, New RightBorder(New Color() With {.Auto = True}) With {.Style = BorderStyleValues.Thin}, New TopBorder(New Color() With {.Auto = True}) With {.Style = BorderStyleValues.Thin}, New BottomBorder(New Color() With {.Auto = True}) With {.Style = BorderStyleValues.Thin}, New DiagonalBorder())) _
, New CellFormats(New CellFormat() With {.FontId = 0, .FillId = 0, .BorderId = 0} _
, New CellFormat() With {.FontId = 1, .FillId = 0, .BorderId = 0, .ApplyFont = True} _
, New CellFormat() With {.FontId = 2, .FillId = 0, .BorderId = 0, .ApplyFont = True} _
, New CellFormat() With {.FontId = 3, .FillId = 0, .BorderId = 0, .ApplyFont = True} _
, New CellFormat() With {.FontId = 0, .FillId = 2, .BorderId = 0, .ApplyFill = True} _
, New CellFormat(New Alignment() With {.Horizontal = HorizontalAlignmentValues.Center, .Vertical = VerticalAlignmentValues.Center}) With {.FontId = 0, .FillId = 0, .BorderId = 0, .ApplyAlignment = True} _
, New CellFormat() With {.FontId = 0, .FillId = 0, .BorderId = 1, .ApplyBorder = True} _
, New CellFormat() With {.FontId = 0, .FillId = 0, .BorderId = 0, .NumberFormatId = 4, .ApplyNumberFormat = True}))
End Function
Public Function AddStyle() As Integer
Dim stylesPart As WorkbookStylesPart = spreadSheet.WorkbookPart.AddNewPart(Of WorkbookStylesPart)()
stylesPart.Stylesheet = GenerateStyleSheet()
stylesPart.Stylesheet.Save()
Return 0
End Function
Public Sub CloseSpreadsheet()
spreadSheet.Close()
End Sub
End Class
The first time I got a complaint about speed was processing I believe 90,000 rows.Code:docName = Path.Combine(strExcelFolder, "storage\awcExcel_" & excelid & ".xlsx")
Dim sss As New SpreadsheetService
If sss.CreateSpreadsheet(docName) Then
Dim rId As String = sss.AddSheet("Sheet1")
Dim nfI As Integer = sss.AddStyle()
Dim sd As SheetData = DirectCast(sss._getWorkSheet(rId).Where(Function(x) x.LocalName = "sheetData").First(), SheetData)
Dim rowH As Row = New Row()
rowH.Spans = New ListValue(Of StringValue)()
If source.Count = 0 Then
rowH.Spans.Items.Add(New StringValue("1:1"))
rowH.RowIndex = 1
Dim cv As New CellValue() With {.Text = "No Data"}
Dim cellH As Cell = New Cell() With {.CellReference = cellAddr(0) & "1", .DataType = CellValues.String, .CellValue = cv}
rowH.Append(cellH)
Else
rowH.Spans.Items.Add(New StringValue("1:" & source(0).Count))
rowH.RowIndex = 1
For i As Integer = 0 To source(1).Count - 1
'Dim sh As String = source(0).ElementAt(i).Key
'If sh.StartsWith("~") Then
' Dim cp As Integer = sh.IndexOf("~", 2)
' If cp <> -1 Then
' sh = sh.Substring(cp + 1)
' End If
'End If
Dim cv As New CellValue() With {.Text = source(1).ElementAt(i).Value}
Dim cellH As Cell = New Cell() With {.CellReference = cellAddr(i) & "1", .DataType = CellValues.String, .CellValue = cv}
rowH.Append(cellH)
Next
End If
sd.Append(rowH)
Dim NumCol(source(0).Count - 1) As Boolean
For i As Integer = 0 To source(0).Count - 1
Dim css As String = source(0).ElementAt(i).Value
If css = "acs-cell-money" Or css = "acs-cell-number" Then
NumCol(i) = True
Else
NumCol(i) = False
End If
Next
For r As Integer = 2 To source.Count - 1
Dim ri As Integer = sd.ChildElements.Count() + 1
Dim header As New Row With {.RowIndex = Convert.ToUInt32(ri)}
sd.Append(header)
For i As Integer = 0 To source(r).Count - 1
Dim sv As String = source(r).ElementAt(i).Value
Dim cdt As CellValues
'Dim css As String = source(0).ElementAt(i).Value
'If css = "acs-cell-money" Or css = "acs-cell-number" Then
' cdt = CellValues.Number
' If sv.Contains(",") Then sv = sv.Replace(",", "")
' If sv = "" Then sv = "0"
'Else
' cdt = CellValues.String
'End If
'If IsNumeric(sv) Then
' cdt = CellValues.Number
' If sv.Contains(",") Then sv = sv.Replace(",", "")
' ' ElseIf IsDate(source(r).ElementAt(i).Value) Then
' ' cdt = CellValues.Date
'Else
' cdt = CellValues.String
'End If
Dim cell1 As Cell = Nothing ' New Cell() With {.CellReference = cellAddr(i) & (ri).ToString, .DataType = cdt, .CellValue = cv}
If NumCol(i) Then ' css = "acs-cell-money" Or css = "acs-cell-number" Then
cdt = CellValues.Number
If sv.Contains(",") Then sv = sv.Replace(",", "")
If sv = "" Then sv = "0"
Dim cv As New CellValue() With {.Text = sv}
cell1 = New Cell() With {.CellReference = cellAddr(i) & (ri).ToString, .DataType = cdt, .CellValue = cv, .StyleIndex = 7}
Else
cdt = CellValues.String
Dim cv As New CellValue() With {.Text = sv}
cell1 = New Cell() With {.CellReference = cellAddr(i) & (ri).ToString, .DataType = cdt, .CellValue = cv}
End If
header.AppendChild(cell1)
Next
Next
sss._getWorkSheet(rId).Save()
End If
sss.CloseSpreadsheet()
Okay. Thanks.