在VB.Net中快速导出大型数据表到Excel电子表格

时间:2013-08-22 18:50:10

标签: vb.net excel datatable rbar

我在这里有一个有趣的难题,我如何快速(在1分钟内)将大型数据表(从SQL填充,35,000行)导出到用户的Excel电子表格中。我有代码可以处理导出,虽然代码本身并没有“错误”,但导出整个文件需要4分钟才会非常慢(如果用户RAM较少或者运行更多,有时会更长)他们的系统)。可悲的是,这是使用旧方法过去10多分钟的改进。简而言之,如果不使用第三方组件,可以更快地制作吗?如果是这样,怎么样?我的代码如下,在写入每行的消息框6和7之间发生减速。谢谢大家花时间看看这个:

    Private Sub btnTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnJeffTest.Click
           Test(MySPtoExport)
    End Sub

Private Sub Test(ByVal SQL As String)
    'Declare variables used to execute the VUE Export stored procedure
    MsgBox("start stop watch")
    Dim ConnectionString As New SqlConnection(CType(ConfigurationManager.AppSettings("ConnString"), String))
    Dim cmdSP As New SqlClient.SqlCommand
    Dim MyParam As New SqlClient.SqlParameter
    Dim MyDataAdapter As New SqlClient.SqlDataAdapter
    Dim ExportDataSet As New DataTable
    Dim FilePath As String

    MsgBox("stop 1 - end of declare")

    Try

        ' open the connection
        ConnectionString.Open()

        ' Use the connection for this sql command
        cmdSP.Connection = ConnectionString

        'set this command as a stored procedure command
        cmdSP.CommandType = CommandType.StoredProcedure

        'get the stored procedure name and plug it in
        cmdSP.CommandText = SQL

        'Add the Start Date parameter if required
        Select Case StDt
            Case Nothing
                ' there's no parameter to add
            Case Is = 0
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add("@StartDate", SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtStartDate.Text
        End Select
        MsgBox("stop 2 - sql ready")
        'Add the End Date parameter if required
        Select Case EdDt
            Case Nothing
                ' there's no parameter to add
            Case Is = 0
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value

                MyParam = cmdSP.Parameters.Add("@EndDate", SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtEndDate.Text
        End Select

        'Add the single parameter 1 parameter if required
        Select Case SPar1
            Case Is = Nothing
                ' there's no parameter to add
            Case Is = ""
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add(SPar1, SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtSingleReportCrt1.Text
        End Select

        'Add the single parameter 2 parameter if required
        Select Case Spar2
            Case Is = Nothing
                ' there's no parameter to add
            Case Is = ""
                ' there's no parameter to add
            Case Else
                'add the parameter name, it's direction and its value
                MyParam = cmdSP.Parameters.Add(Spar2, SqlDbType.VarChar)
                MyParam.Direction = ParameterDirection.Input
                MyParam.Value = Me.txtSingleReportCrt2.Text
        End Select

        MsgBox("stop 3 - params ready")

        'Prepare the data adapter with the selected command 
        MyDataAdapter.SelectCommand = cmdSP

        ' Set the accept changes during fill to false for the NYPDA export
        MyDataAdapter.AcceptChangesDuringFill = False

        'Fill the Dataset tables (Table 0 = Exam Eligibilities, Table 1  = Candidates Demographics)
        MyDataAdapter.Fill(ExportDataSet)

        'Close the connection
        ConnectionString.Close()

        'refresh the destination path in case they changed it
        SPDestination = txtPDFDestination.Text

        MsgBox("stop 4 - procedure ran, datatable filled")

        Select Case ExcelFile
            Case True

                FilePath = SPDestination & lblReportName.Text & ".xls"

                Dim _excel As New Microsoft.Office.Interop.Excel.Application
                Dim wBook As Microsoft.Office.Interop.Excel.Workbook
                Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet

                wBook = _excel.Workbooks.Add()
                wSheet = wBook.ActiveSheet()

                Dim dt As System.Data.DataTable = ExportDataSet
                Dim dc As System.Data.DataColumn
                Dim dr As System.Data.DataRow
                Dim colIndex As Integer = 0
                Dim rowIndex As Integer = 0

                MsgBox("stop 5 - excel stuff declared")

                For Each dc In dt.Columns
                    colIndex = colIndex + 1
                    _excel.Cells(1, colIndex) = dc.ColumnName
                Next

                MsgBox("stop 6 - Header written")

                For Each dr In dt.Rows
                    rowIndex = rowIndex + 1
                    colIndex = 0
                    For Each dc In dt.Columns
                        colIndex = colIndex + 1
                        _excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
                    Next
                Next

                MsgBox("stop 7 - rows written")

                wSheet.Columns.AutoFit()

                MsgBox("stop 8 - autofit complete")

                Dim strFileName = SPDestination & lblReportName.Text & ".xls"

                If System.IO.File.Exists(strFileName) Then
                    System.IO.File.Delete(strFileName)
                End If

                MsgBox("stop 9 - file checked")

                wBook.SaveAs(strFileName)
                wBook.Close()
                _excel.Quit()
        End Select

        MsgBox("File " & lblReportName.Text & " Exported Successfully!")


        'Dispose of unneeded objects
        MyDataAdapter.Dispose()
        ExportDataSet.Dispose()
        StDt = Nothing
        EdDt = Nothing
        SPar1 = Nothing
        Spar2 = Nothing
        MyParam = Nothing
        cmdSP.Dispose()
        cmdSP = Nothing
        MyDataAdapter = Nothing
        ExportDataSet = Nothing

    Catch ex As Exception
        '  Something went terribly wrong.  Warn user.
        MessageBox.Show("Error: " & ex.Message, "Stored Procedure Running Process ", _
       MessageBoxButtons.OK, MessageBoxIcon.Error)

    Finally
        'close the connection in case is still open
        If Not ConnectionString.State = ConnectionState.Closed Then
            ConnectionString.Close()
            ConnectionString = Nothing
        End If

        ' reset the fields
        ResetFields()

    End Try
End Sub

5 个答案:

答案 0 :(得分:3)

与使用VBA自动化Excel时一样,您可以将数组直接分配给Range对象的值:这是作为单个操作完成的,因此您可以消除与跨越您之间的过程边界进行多次调用相关的开销。网络代码和Excel实例。

例如,请参阅此处接受的答案:Write Array to Excel Range

答案 1 :(得分:1)

这是我自己的一段代码,用于执行非常快速将数据从DataTable导出到Excel工作表(使用"秒表"对象来比较速度和让我发表评论):

Dim _excel As New Excel.Application
Dim wBook As Excel.Workbook
Dim wSheet As Excel.Worksheet

wBook = _excel.Workbooks.Add()
wSheet = wBook.ActiveSheet()


Dim dc As System.Data.DataColumn
Dim colIndex As Integer = 0
Dim rowIndex As Integer = 0
'Nombre de mesures
Dim Nbligne As Integer = DtMesures.Rows.Count

'Ecriture des entêtes de colonne et des mesures
'(Write column headers and data)

For Each dc In DtMesures.Columns
  colIndex = colIndex + 1
  'Entête de colonnes (column headers)
  wSheet.Cells(1, colIndex) = dc.ColumnName
  'Données(data)
  'You can use CDbl instead of Cobj If your data is of type Double
  wSheet.Cells(2, colIndex).Resize(Nbligne, ).Value = _excel.Application.transpose(DtMesures.Rows.OfType(Of DataRow)().[Select](Function(k) CObj(k(dc.ColumnName))).ToArray())
Next

答案 2 :(得分:0)

我们有一个VB.NET应用程序正是这样做的,并且对于那些使用慢速PC的用户来说花了更长的时间......有时候是15分钟。

该应用程序现在是一个ASP / VB.NET应用程序,它只是构建一个HTML表格并将结果输出为.xls扩展名... excel能够读取HTML表格并将其解析为网格格式。您仍然可以传入XML以进行格式化和选项,水平窗格锁定等。

如果您没有使用ASP.NET的选项...尝试寻找一种构建HTML表格字符串的方法并使用excel解析&为你填充......快得多!我确信excel也可以解析其他类型...... XML,数组,HTML等...所有这些都比通过VB.NET对象手动构建每一行更快。

答案 3 :(得分:0)

尽管这个问题是几年前提出的,但我认为我会添加解决方案,因为问题是在VB中提出的,“最佳答案”是在C#中。该解决方案可在4秒内在具有16GB RAM的i7系统上写入22,000多行(1.9MB)。


Imports Excel = Microsoft.Office.Interop.Excel

Public Class Main
    Private Sub btnExportToExcel(sender As Object, e As EventArgs) Handles btnExpToExcel.Click
        'Needed for the Excel Workbook/WorkSheet(s)
        Dim app As New Excel.Application
        Dim wb As Excel.Workbook = app.Workbooks.Add()
        Dim ws As Excel.Worksheet
        Dim strFN as String = "MyFileName.xlsx"    'must have ".xlsx" extension

        'Standard code for filling a DataTable from SQL Server
        Dim strSQL As String = "My SQL Statement for the DataTable"
        Dim conn As New SqlConnection With {.ConnectionString = "My Connection"}
        Dim MyTable As New DataTable
        Dim cmd As New SqlCommand(strSQL, conn)
        Dim da As New SqlDataAdapter(cmd)
        da.Fill(MyTable)

        'Add a sheet to the workbook and fill it with data from MyTable
        'You could create multiple tables and add additional sheets in a loop
        ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        DataTableToExcel(MyTable, ws, strSym)

        wb.SaveAs(strFN)    'save and close the WorkBook
        wb.Close()

        MsgBox("Export complete.")
    End Sub

    Private Sub DataTableToExcel(dt As DataTable, ws As Excel.Worksheet, TabName As String)
        Dim arr(dt.Rows.Count, dt.Columns.Count) As Object
        Dim r As Int32, c As Int32
        'copy the datatable to an array
        For r = 0 To dt.Rows.Count - 1
            For c = 0 To dt.Columns.Count - 1
                arr(r, c) = dt.Rows(r).Item(c)
            Next
        Next

        ws.Name = TabName   'name the worksheet
        'add the column headers starting in A1
        c = 0
        For Each column As DataColumn In dt.Columns
            ws.Cells(1, c + 1) = column.ColumnName
            c += 1
        Next
        'add the data starting in cell A2
        ws.Range(ws.Cells(2, 1), ws.Cells(dt.Rows.Count, dt.Columns.Count)).Value = arr
    End Sub
End Class

希望有帮助。

答案 4 :(得分:0)

CPRouse 的答案对我有用,只是它忽略了最后一行数据。在 Private Sub DataTableToExcel 函数中,我在这一行的 rows.count 中加了 1 并写入了所有记录。 ws.Range(ws.Cells(2, 1), ws.Cells(dt.Rows.Count + 1, dt.Columns.Count)).Value = arr