[RESOLVED] Speed up Excel creation

[projecttoday]

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?

[dday9]

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.

[projecttoday]

It must be Excel.

[szlamany]

I use code like this to make a s/s

What are you using?

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()

[TnTinMN]

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.

[projecttoday]

szlamany, this is the 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

[projecttoday]

TnTinMN, the posted code takes about a minute to copy about 3,000 rows.

[projecttoday]

szlamany,

I'm getting does not contain any public member or cannot be found on

Imports DocumentFormat.OpenXml

[szlamany]

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...

[TnTinMN]

TnTinMN, the posted code takes about a minute to copy about 3,000 rows.

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.

[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.

[szlamany]

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).

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

And here is how I call it on a AJAX post with a JSON array of record objects

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()

The first time I got a complaint about speed was processing I believe 90,000 rows.

[projecttoday]

Okay. Thanks.