导出数据到 Excel 更快

• 下载源代码 - 1.2 MB

引言

本文将帮助您使用三种不同的方法将数据导出到 Excel 工作簿。

1. 基本方法：逐个单元格复制数据。
2. 使用 FileStreamWriter 对象：将流写入文件。
3. 对象粘贴方法：将数据复制到数组并直接粘贴到 Excel 工作簿。

背景

在基本方法中，复制数据需要花费大量时间。使用 FileSteamWriter 或对象粘贴方法，与基本方法相比，复制数据要快得多。

使用代码

基本方法的代码

您需要向应用程序添加对 Excel COM 对象的引用。 我们将声明两个对象：Ex as Excel Application，Ws as Excel Worksheet，并将 Ws 设置为工作簿的第一个工作表。

对于标题，我们需要为表格的每一列编写一个循环来显示标题。 要检索列的标题，我们使用了 Columns(Index).Caption 属性或 ColumnName 属性。

现在，对于所有数据，我们需要编写两个循环：一个用于行，另一个用于列（如代码所示）。

''Creating Excel Workbook using EarlyBinding
''(Add reference of Excel COM Object to your project
Dim Ex As New Excel.Application
Dim Ws As Excel.Worksheet
Ws = Ex.Workbooks.Add().Worksheets(1)

''>>Creating Excel Workbook using CreateObject function (LateBinding)
''Dim Ex As Object
''Dim Wb As Object
''Dim Ws As Object
''Ex = CreateObject("Excel.Application")
''Wb = Ex.Workbooks.Add
''Ws = Ex.Worksheets(1)
''Ws.Name = "All Data"

Dim Row, Col, i, j As Integer
pb.Maximum = Ds.Tables(0).Rows.Count
Row = 1
Col = 1

''For Heading
lblCount.Text = "Generating Heading." : Me.Refresh()
For i = 0 To Ds.Tables(0).Columns.Count - 1
    Ws.Cells(Row, Col) = Ds.Tables(0).Columns(i).Caption
    Ws.Cells(Row, Col).Font.Bold = True : _
      Ws.Cells(Row, Col).Font.ColorIndex = 3 : Col += 1
Next

Row = 2
Col = 1
pb1.Maximum = Ds.Tables(0).Columns.Count
lblCount.Text = "Preparing for Export Data."
For i = 0 To Ds.Tables(0).Rows.Count - 1
    '
    'FOR ALL DATA
    '

    pb1.Value = 0
    For j = 0 To Ds.Tables(0).Columns.Count - 1
        Ws.Cells(Row, Col) = Ds.Tables(0).Rows(i)(j).ToString : Col += 1
        pb1.Value += 1
    Next
    ''If data is more than 65500 then set ws to next sheet
    If Row = 65500 Then
        Row = 1
        Ws = Ex.Worksheets(2)
    End If

    Col = 1
    Row += 1
    lblCount.Text = i + 1 & " : Exported"
    lblCount.Refresh()
    pb.Value += 1
Next
pb.Value = 0
Ex.Visible = True
MsgBox(Ds.Tables(0).Rows.Count & " : Records Exported. ", _
       MsgBoxStyle.Information)
Ex.Visible = True
Ex.Quit()
Ex = Nothing
Ws = Nothing

使用 StreamWriter 方法

这种方法是将数据导出到任何类型的文件的一种更短、更快速的方法。

在此方法中，我们将使用 System.IO 命名空间，并直接创建程序员指定的文件路径，以及您选择的扩展名，例如 .xls 或 .doc 等。

编码从需要存储新创建文件的文件路径开始。 现在，声明一个 IO.StreamWriter 对象，并指定文件路径。 在此方法中，每个数据行/列的值都会被添加到字符串中，包括管道符号“|”作为分隔符。

现在，创建的文件包含以管道分隔符（CSV 格式）分隔的单列数据。

'File name and path
Dim filePath As String = "c:\SystemIO_Exported_Data_AsOn_" & _
                         Now.ToShortDateString & ".xls"

'Stream Writer object to write the stream to file
Dim writer As New IO.StreamWriter(IO.File.Create(filePath))
Dim dRow As DataRow
Dim str As String = String.Empty

''For Heading
lblCount.Text = "Generating Heading." : Me.Refresh()
For i As Integer = 0 To Ds.Tables(0).Columns.Count - 1
    str += Ds.Tables(0).Columns.Item(i).Caption & vbTab
Next
'Write stream to file adding a new line to stream
str += vbNewLine
writer.Write(str)
writer.Flush()
pb.Maximum = Ds.Tables(0).Rows.Count + 1
For Each dRow In Ds.Tables(0).Rows

    str = ""
    For col As Integer = 0 To Ds.Tables(0).Columns.Count - 1
        Dim STR1 As String = ""
        Dim c As Char = Chr(32)
        Dim sep() As Char = " "
        Dim str2() As String
        str2 = dRow(col).ToString.Split(sep)
        For z As Integer = 0 To str2.Length - 1
            'replacing all spaces and tabs with '|' (pipe sign)
            Dim y As String = str2(z).ToString.Replace(Chr(32), _
                     " ").Replace(Chr(13), " ").Replace(Chr(10), _
                     " ").Replace(Chr(9), " ").Replace("|", " ")
            STR1 += y & " "
        Next
        str += STR1 & "| "
        pb.Value += 1
    Next
    str += vbNewLine
    writer.Write(str)
    writer.Flush()
    pb.Value = 0
Next
        'Close the stream writer object
        writer.Close()
        pb.Value = 0
        MsgBox("Data Exported Successfully.")

对象粘贴方法

这是将数据导出到 Excel 的另一种更快速的方法。 在此代码中，我们创建一个二维数组，例如 Dim rawData(dt.Rows.Count, dt.Columns.Count - 1) As Object，以包含数据表的的数据。

一旦数据存储在数组中，它将使用 Excel 工作表的 Range().Value 方法将数据相应地粘贴到 Excel 工作表中，如下所示

If Ds.Tables.Count > 3 Then
    MsgBox("There Are More than 3 data table. " & _ 
           "Data can not be exported.", MsgBoxStyle.Information)
    Exit Sub
End If
Dim sheetIndex As Integer
Dim Ex As Object
Dim Wb As Object
Dim Ws As Object
Ex = CreateObject("Excel.Application")
Wb = Ex.workbooks.add

' Copy each DataTable as a new Sheet
For Each dt As System.Data.DataTable In Ds.Tables
    'On Error Resume Next
    Dim col, row As Integer
    ' Copy the DataTable to an object array
    Dim rawData(dt.Rows.Count, dt.Columns.Count - 1) As Object
    lblCount.Text = "Copying Columns Name." : Me.Refresh()
    ' Copy the column names to the first row of the object array
    pb1.Maximum = dt.Columns.Count + 1
    pb1.Value = 0
    For col = 0 To dt.Columns.Count - 1
        rawData(0, col) = dt.Columns(col).ColumnName.ToUpper
        pb1.Value += 1
    Next
    lblCount.Text = "Copying Data" : Me.Refresh()
    pb1.Value = 0
    ' Copy the values to the object array
    pb.Maximum = dt.Rows.Count + 1
    pb.Value = 0
    For col = 0 To dt.Columns.Count - 1
        For row = 0 To dt.Rows.Count - 1
            rawData(row + 1, col) = dt.Rows(row).ItemArray(col)
            pb.Value += 1
        Next
        pb.Value = 0
        pb1.Value += 1
    Next
    pb.Value = 0
    pb1.Value = 0
    lblCount.Text = "" : Me.Refresh()
    ' Calculate the final column letter
    Dim finalColLetter As String = String.Empty
    finalColLetter = ExcelColName(dt.Columns.Count)
    'Generate Excel Column Name (Column ID)


    sheetIndex += 1
    Ws = Wb.Worksheets(sheetIndex)
    Ws.name = dt.TableName
    Dim excelRange As String = String.Format("A1:{0}{1}", _
                               finalColLetter, dt.Rows.Count + 1)

    Ws.Range(excelRange, Type.Missing).Value2 = rawData
    Ws = Nothing
Next

Wb.SaveAs("C:\ExportedDataUsingObjectPastingMethod.xls", _
          Type.Missing, Type.Missing, Type.Missing, Type.Missing, _
          Type.Missing, Type.Missing, Type.Missing, Type.Missing, _
          Type.Missing, Type.Missing, Type.Missing)
Wb.Close(True, Type.Missing, Type.Missing)
Wb = Nothing
' Release the Application object
Ex.Quit()
Ex = Nothing
' Collect the unreferenced objects
GC.Collect()
MsgBox("Exported Successfully.", MsgBoxStyle.Information)

我还编写了一个函数来查找 Excel 工作表中的列名

Public Function ExcelColName(ByVal Col As Integer) As String
    If Col < 0 And Col > 256 Then
        MsgBox("Invalid Argument", MsgBoxStyle.Critical)
        Return Nothing
        Exit Function
    End If
    Dim i As Int16
    Dim r As Int16
    Dim S As String
    If Col <= 26 Then
        S = Chr(Col + 64)
    Else
        r = Col Mod 26
        i = System.Math.Floor(Col / 26)
        If r = 0 Then
            r = 26
            i = i - 1
        End If
        S = Chr(i + 64) & Chr(r + 64)
    End If
    ExcelColName = S
End Function