導出數據到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&nb
sp;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 ''是到工作簿中唯一的、不同的數據表名