DataTable输出到Excel

Imports System.Data
Imports System.Data.OleDb
Imports System.IO
Imports System.Text

''' <summary>
''' DataTable的导入导出(CSV,XLS)
''' </summary>
Public NotInheritable Class Table

#Region "Consts"

    Private Const CsvConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Text;{1}'"
    Private Const XlsConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Excel 8.0;HDR={1};IMEX=1'"
    Private Const CsvSql As String = "Select * From [{0}.csv]"
    Private Const XlsSql As String = "Select * From [Sheet1$]"
    Private Shared chars() As Char = {vbCr, vbLf, vbTab, Chr(34), Chr(44)}
    Public Shared Encod As Encoding = Encoding.GetEncoding("GB2312")

#End Region

#Region "Read"

    ''' <summary>
    ''' 读取CSV文件
    ''' </summary>
    ''' <param name="filename">CSV文件路径</param>
    ''' <param name="HDR">是否有列标题</param>
    ''' <returns>返回的DataTable</returns>
    ''' <remarks></remarks>
    Public Shared Function CsvRead(ByVal filename As String, Optional ByVal HDR As Boolean = True) As DataTable
        Dim constr As String = String.Format(CsvConStr, Path.GetDirectoryName(filename), IIf(HDR, String.Empty, "HDR=no;"))
        Dim con As New OleDbConnection(constr)
        Dim Name As String = Path.GetFileNameWithoutExtension(filename)
        Dim dt As New DataTable(Name)
        Using da As New OleDbDataAdapter(String.Format(CsvSql, Name), con)
            Try
                da.Fill(dt)
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try
        End Using
        con.Dispose()
        Return dt
    End Function

    ''' <summary>
    ''' 读取CSV字符串
    ''' </summary>
    ''' <param name="CsvString">Csv格式字符串</param>
    ''' <returns>返回的DataTable</returns>
    ''' <remarks></remarks>
    Public Shared Function CsvStringRead(ByVal CsvString As String) As DataTable
        Dim dt As New DataTable
        On Error Resume Next
        Dim str() As String = CsvString.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
        Dim cs() As String = str(0).Split({","c})
        For Each c As String In cs
            dt.Columns.Add(c, GetType(String))
        Next
        For i = 1 To str.Length - 1
            Dim Cells() As String = str(i).Split({","c})
            If Cells.Length <> dt.Columns.Count Then
                Continue For
            Else
                dt.Rows.Add(Cells)
            End If
        Next
        'dt.PrimaryKey = New DataColumn() {dt.Columns(0)}
        Return dt
    End Function

    ''' <summary>
    ''' 读取Excel文件
    ''' </summary>
    ''' <param name="filename">Excel文件路径</param>
    ''' <param name="HDR">是否有列标题</param>
    ''' <returns>返回的DataTable</returns>
    ''' <remarks></remarks>
    Public Shared Function ExcelRead(ByVal filename As String, Optional ByVal HDR As Boolean = False) As DataTable
        Dim constr As String = String.Format(XlsConStr, filename, IIf(HDR, "yes", "no"))
        Dim con As New OleDbConnection(constr)
        Dim dt As New DataTable("Sheet1")
        Using da As New OleDbDataAdapter(XlsSql, con)
            Try
                da.Fill(dt)
            Catch ex As OleDbException
                MsgBox("确认表名是否是'Sheet1'!")
            End Try
        End Using
        con.Dispose()
        Return dt
    End Function

#End Region

#Region "Write"

    ''' <summary>
    ''' 保存DataTable到CSV文件
    ''' </summary>
    ''' <param name="Path">CSV文件路径</param>
    ''' <param name="Table">要保存的DataTable</param>
    ''' <remarks></remarks>
    Public Shared Sub CsvSave(ByVal Path As String, ByVal Table As DataTable)
        Using sw As New StreamWriter(Path, False, Encod)
            sw.Write(GetString(Table, ","))
            sw.Flush()
            sw.Close()
        End Using
    End Sub

    ''' <summary>
    ''' 保存DataTable到Excel文件
    ''' </summary>
    ''' <param name="Path">Excel文件路径</param>
    ''' <param name="Table">要保存的DataTable</param>
    ''' <remarks></remarks>
    Public Shared Sub ExcelSave(ByVal Path As String, ByVal Table As DataTable)
        Using sw As New StreamWriter(Path, False, Encod)
            sw.Write(GetString(Table, vbTab))
            sw.Flush()
            sw.Close()
        End Using
    End Sub

#End Region

#Region "Utils"

    Public Shared Function GetString(ByVal Table As DataTable, ByVal Link As String) As StringBuilder
        Dim str As New StringBuilder
        If Table.Columns.Count = 0 Then Return str
        For Each c As DataColumn In Table.Columns
            str.Append(CellString(c.ColumnName) & Link)
        Next
        str.Remove(str.Length - 1, 1).AppendLine()
        str.Append(GetString(Table.Rows, Link))
        Return str
    End Function

    Public Shared Function GetString(ByVal Rows As DataRowCollection, ByVal Link As String) As StringBuilder
        Dim str As New StringBuilder
        For Each Row As DataRow In Rows
            For Each Item In Row.ItemArray
                str.Append(CellString(Item.ToString)).Append(Link)
            Next
        str.Remove(str.Length - 1, 1).AppendLine()
        Next
        Return str
    End Function

    Public Shared Function CellString(ByVal str As String) As String
        If String.IsNullOrWhiteSpace(str) Then Return String.Empty
        If Contains(str, chars) Then
            str = str.Replace(Chr(34), Chr(34) & Chr(34))
            str = Chr(34) & str & Chr(34)
        End If
        Return str
    End Function

    Public Shared Function Contains(ByVal str As String, ByVal ParamArray chars() As Char) As Boolean
        For Each c As Char In chars
            If str.Contains(c) Then Return True
        Next
        Return False
    End Function

#End Region

End Class

http://www.codeproject.com/Articles/8500/Reading-and-Writing-Excel-using-OLEDB