导出数据到excel中

Public Class BqExcelClass BqExcel
    Dim lConnString As String = ""
    Dim lBookName As String = ""
    Dim lSchemaTable As DataTable
    Dim lMessErr As String '得到当前错误信息
    Dim lMessSuc As String '得到当前正确的信息

    Public Sub New()Sub New(ByVal sbookName As String)
        MyBase.new()
        Dim s As String
        If System.IO.File.Exists(sbookName) = True Then
            lBookName = sbookName
        Else   '如果该文件不存在，则在C：新建一个
            lBookName = sbookName  ' "C:cdbqss的工作簿.xls"
        End If
        s = "Provider=Microsoft.Jet.OleDb.4.0; data Source=" + Chr(34) & lBookName + Chr(34)
        s += "; Extended ProPerties=""Excel 8.0;HDR=Yes;"""
        lConnString = s
        lSchemaTable = BqPSchemaTable  '内部要用的，所以先要读出来
    End Sub

    Public ReadOnly Property BqPSchemaTable()Property BqPSchemaTable() As DataTable
        Get
            Dim lCn As New System.Data.OleDb.OleDbConnection
            Dim m0 As DataTable = Nothing
            Try
                lCn.ConnectionString = lConnString
                lCn.Open()
                '得到该工作簿中的结构，即工作表的名称
                m0 = lCn.GetOleDbSchemaTable(OleDb.OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, Nothing})
            Catch ErrCode As Exception
            Finally
                lCn.Close()
                lCn.Dispose()
            End Try
            Return m0
        End Get
    End Property

    Public ReadOnly Property BqPEessErr()Property BqPEessErr() As String
        Get
            Return lMessErr
        End Get
    End Property   '错误的提示
    Public ReadOnly Property BqPEessSuc()Property BqPEessSuc() As String
        Get
            Return lMessSuc
        End Get
    End Property   '正确的提示


    Function GetSheetExists()Function GetSheetExists(ByVal sSheetName As String) As Boolean
        '判断该表名，是否在工作簿中存在
        Dim lSheet As String = sSheetName
        Dim m0 As Boolean = False
        Try
            If IsNothing(lSchemaTable) = False AndAlso lSchemaTable.Rows.Count > 0 Then
                For Each r As DataRow In lSchemaTable.Rows
                    If Trim(UCase(lSheet)) = Trim(UCase(r("TABLE_NAME"))) Then
                        m0 = True
                        Exit For
                    End If
                Next
            End If
        Catch ex As Exception
        End Try
        Return m0
    End Function  '判断该表名，是否在工作簿中存在
    Function GetSheetNameOnly()Function GetSheetNameOnly() As String
        '是到工作簿中唯一的、不同的数据表名
        Dim m0 As String = ""
        Try
            Dim i As Integer = 1
            Dim m1 As String = "sheet" & Trim(i.ToString)
            If IsNothing(lSchemaTable) = False AndAlso lSchemaTable.Rows.Count > 0 Then
                Do While True
                    If GetSheetExists(m1) = True Then  '如果该表已经存在，则更新取一个
                        i = i + 1
                        m1 = "sheet" & Trim(i.ToString)
                    Else
                        m0 = m1
                        Exit Do
                    End If
                Loop
            End If
        Catch ex As Exception
        End Try
        Return m0
    End Function '是到工作簿中唯一的、不同的数据表名

    Public Function BqMtoExcel()Function BqMtoExcel(ByVal ltb As DataTable, ByVal sSheeName As String) As Boolean
        '参数：ltb 要导出的数据表，lname 要保存的Excle文件名
        '数据导出到Excel中
        '如果成功，则反回true
        Dim m0 As Boolean = False
        Dim lCn As New System.Data.OleDb.OleDbConnection
        Dim lCmd As New System.Data.OleDb.OleDbCommand
        Try
            Dim lSheet As String
            If IsNothing(ltb) = True Then Return m0
            If IsNothing(lBookName) = True Then Return m0
            If IsNothing(sSheeName) = True Then Return m0
            lBookName = Trim(lBookName)
            sSheeName = Trim(sSheeName)

            lSheet = IIf(Len(sSheeName) < 1, "sheet1", sSheeName)
            lSheet = lSheet.Replace("-", "")  '不能包含以下字符
            lSheet = lSheet.Replace(":", "")
            lSheet = lSheet.Replace("$", "")
            lSheet = lSheet.Replace(".", "")
            lSheet = lSheet.Replace(" ", "_")
            lSheet = lSheet.Replace("　", "")

            If GetSheetExists(lSheet) = True Then
                lSheet = GetSheetNameOnly()
            End If
            lMessErr = "" '把错误信息设置空
            lMessSuc = "" ' 把正确的信息提示也改为空

            '第一行插入列标题 
            Dim s As String
            s = "CREATE TABLE " & lSheet & " ("
            Dim n As Integer = ltb.Columns.Count - 1
            Dim i As Integer
            For i = 0 To n
                '这里是插第一行，即表中字段的名称，
                '但应该根据表的数据类型，生成不同的类型
                '主要是区分  文本、数值、日期与时间
                '    再把这个改一下，传入以下参数，表、输出文件名
                '    如果，输出文件名中已经有表了，则应该改变以下的“sheet1”名。
                If i <> n Then
                    s = s & ltb.Columns(i).Caption & " text,"
                Else
                    s = s & ltb.Columns(i).Caption & " text)"
                End If
            Next

            lCn.ConnectionString = lConnString
            lCn.Open()
            lCmd.Connection = lCn
            lCmd.CommandType = CommandType.Text
            lCmd.CommandText = s
            lCmd.ExecuteNonQuery()

            '插入各行 
            For i = 0 To ltb.Rows.Count - 1
                s = "INSERT INTO " & lSheet & " VALUES('"
                For n = 0 To ltb.Columns.Count - 1
                    If n <> ltb.Columns.Count - 1 Then
                        s = s & ltb.Rows(i).Item(n) & "','"
                    Else
                        s = s & ltb.Rows(i).Item(n) & "')"
                    End If
                Next
                lCmd.CommandText = s
                lCmd.ExecuteNonQuery()
            Next
            m0 = True
            s = "数据已经成功导出到EXCEL文件中！" & Chr(13) & Chr(13) & Chr(13) & Chr(13)
            s += "  工作簿：" & lBookName & vbTab & vbTab & Chr(13) & Chr(13)
            s += "  工作表：" & lSheet & vbTab & vbTab & Chr(13) & Chr(13)
            lMessSuc = s
            'System.Windows.Forms.MessageBox.Show(s, "cdbqss数据导出成功 ", System.Windows.Forms.MessageBoxButtons.OK, System.Windows.Forms.MessageBoxIcon.Information)
        Catch ErrCode As Exception
            Dim m As String
            m = "  错误来源：  " & ErrCode.Source & vbCrLf & vbCrLf
            m += "  错误信息：  " & ErrCode.Message & vbCrLf & vbCrLf
            m += "  引发事件：  " & ErrCode.TargetSite.ToString & vbCrLf & vbCrLf
            lMessErr = m
            'MsgBox("错误信息：" & ErrCode.Message & vbCrLf & vbCrLf & _
            '"引发事件：" & ErrCode.TargetSite.ToString, MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "错误来源：" & ErrCode.Source)
            m0 = False
        Finally
            lCmd.Dispose()
            lCn.Close()
            lCn.Dispose()
        End Try
        Return m0
    End Function '数据导出到Excel中
    Public ReadOnly Property BqPGetTable()Property BqPGetTable(ByVal sSheetName As String) As DataTable
        Get
            Dim lCn As New System.Data.OleDb.OleDbConnection
            Dim lCmd As New System.Data.OleDb.OleDbCommand
            Dim m0 As DataTable = Nothing
            Try
                Dim m1 As String
                m1 = Trim(sSheetName)
                If GetSheetExists(sSheetName) = True Then  '如果存在这个工作表，才读数 
                    Dim s As String
                    Dim lDaSet As New System.Data.DataSet
                    Dim lAdapter As New System.Data.OleDb.OleDbDataAdapter
                    lMessErr = "" '把错误信息设置空
                    lMessSuc = "" ' 把正确的信息提示也改为空

                    s = "SELECT * FROM [" & m1 & "]"
                    lCn.ConnectionString = lConnString
                    lCn.Open()
                    lCmd.Connection = lCn
                    lCmd.CommandText = s
                    lAdapter = New System.Data.OleDb.OleDbDataAdapter(lCmd)
                    lAdapter.Fill(lDaSet)
                    m0 = lDaSet.Tables(0)
                    s = "工作表数据已经成功读出！" & Chr(13) & Chr(13) & Chr(13) & Chr(13)
                    s += "  工作簿：" & lBookName & vbTab & vbTab & Chr(13) & Chr(13)
                    s += "  工作表：" & m1 & vbTab & vbTab & Chr(13) & Chr(13)
                    lMessSuc = s
                End If
                'System.Windows.Forms.MessageBox.Show(s, "cdbqss数据导出成功 ", System.Windows.Forms.MessageBoxButtons.OK, System.Windows.Forms.MessageBoxIcon.Information)
            Catch ErrCode As Exception
                Dim m As String
                m = "  错误来源：  " & ErrCode.Source & vbCrLf & vbCrLf
                m += "  错误信息：  " & ErrCode.Message & vbCrLf & vbCrLf
                m += "  引发事件：  " & ErrCode.TargetSite.ToString & vbCrLf & vbCrLf
                lMessErr = m
            Finally
                lCmd.Dispose()
                lCn.Close()
                lCn.Dispose()
            End Try
            Return m0
        End Get
    End Property '根据工作表得到数据

End Class