DataTable輸出到Excel

Imports System.DataImports System.Data.OleDbImports System.IOImports 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 RegionEnd Class

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