导出SqlServer、Access、DBase数据到Excel表

[水如烟]

利用Excel.QueryTables

[水如烟]

DbTranExcel.vb

Option Strict Off

Imports System.IO
Imports System.Runtime.InteropServices

Public MustInherit Class DbTranExcel
    Implements IDisposable

    Private gApplication As Object = CreateObject("Excel.Application")

    Private Property Application() As Object
        Get
            Return gApplication
        End Get
        Set(ByVal value As Object)
            gApplication = value
        End Set
    End Property

    Private ReadOnly Property ActiveWorkbook() As Object
        Get
            Return Application.ActiveWorkbook
        End Get
    End Property

    Private ReadOnly Property ActiveSheet() As Object
        Get
            Return Application.ActiveSheet
        End Get
    End Property

    Public Property Visible() As Boolean
        Get
            Return Me.Application.Visible
        End Get
        Set(ByVal value As Boolean)
            Me.Application.Visible = value
        End Set
    End Property

    Public Sub CreateOrOpenWorkbook(ByVal xlsFile As String)

        If Me.Application.Workbooks.Count > 0 Then
            Throw New Exception("仅接受一份工作簿")
        End If

        If Not xlsFile.ToLower.EndsWith(".xls") Then
            xlsFile += ".xls"
        End If

        If xlsFile.IndexOf("\") = -1 Then
            xlsFile = Path.Combine(Me.Application.DefaultFilePath, xlsFile)
        End If

        If File.Exists(xlsFile) Then
            Me.Application.Workbooks.Open(xlsFile)
        Else
            Me.Application.Workbooks.Add.SaveAs(xlsFile)
        End If
    End Sub

    Public Sub Save()
        If Me.Application.Workbooks.Count = 0 Then Return

        Me.ActiveWorkbook.Save()
    End Sub

    Public Sub Close()
        Me.Dispose()
    End Sub

    Public Sub CreateOrSelectWorksheet(ByVal sheetName As String)
        Dim sh As Object = GetWorksheet(sheetName)

        If sh IsNot Nothing Then
            sh.Activate()
        Else
            sh = Me.ActiveWorkbook.Sheets.Add()
            Try
                sh.Name = sheetName '工作表称最长只有31个字符
            Catch ex As Exception
            End Try
        End If
    End Sub

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Private Function InternalImport(ByVal connectionString As String, ByVal selectstring As String) As String
        Me.ActiveSheet.Cells.Clear()

        Dim msg As String = String.Empty

        Try
            With Me.ActiveSheet.QueryTables.Add(Connection:=connectionString, Destination:=Me.ActiveSheet.Range("A1"))
                .CommandText = New String() {selectstring}
                .Refresh(BackgroundQuery:=False)
            End With
        Catch ex As Exception
            msg = ex.Message
        End Try

        If Me.ActiveSheet.QueryTables.Count > 0 Then Me.ActiveSheet.QueryTables(1).Delete()

        Return msg
    End Function

    Private Function GetWorksheet(ByVal sheetName As String) As Object
        Dim sh As Object = Nothing

        For i As Integer = 1 To Me.ActiveWorkbook.Sheets.Count
            sh = Me.ActiveWorkbook.Sheets(i)

            If String.Compare(sh.Name, sheetName, True) = 0 Then Exit For

            sh = Nothing
        Next

        Return sh
    End Function

    Private disposedValue As Boolean = False        ' 检测冗余的调用

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                ' TODO: 释放其他状态(托管对象)。
            End If

            ' TODO: 释放您自己的状态(非托管对象)。
            ' TODO: 将大型字段设置为 null。

            If Me.Application IsNot Nothing Then
                Try
                    Me.Application.Quit()
                Catch ex As Exception
                End Try

                If Me.Application IsNot Nothing Then
                    Try
                        Marshal.ReleaseComObject(Me.Application)
                        Me.Application = Nothing
                    Catch ex As Exception
                    End Try
                End If
            End If
        End If
        Me.disposedValue = True
    End Sub

#Region " IDisposable Support "
    ' Visual Basic 添加此代码是为了正确实现可处置模式。
    Public Sub Dispose() Implements IDisposable.Dispose
        ' 不要更改此代码。请将清理代码放入上面的 Dispose(ByVal disposing As Boolean) 中。
        Dispose(True)
        GC.SuppressFinalize(Me)
        GC.Collect(2)
    End Sub
#End Region


    Protected MustOverride Function GetConnectionString(ByVal dataSource As String, ByVal database As String) As String
    Protected MustOverride Function GetConnectionString(ByVal dataSource As String, ByVal database As String, ByVal userID As String, ByVal Password As String) As String

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal dataSourceOrDefaultDir As String, ByVal catalogOrDbq As String, ByVal selectstring As String) As String
        Dim connectionString As String = Me.GetConnectionString(dataSourceOrDefaultDir, catalogOrDbq)
        Return Me.InternalImport(connectionString, selectstring)
    End Function

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal dataSourceOrDefaultDir As String, ByVal catalogOrDbq As String, ByVal userID As String, ByVal Password As String, ByVal selectString As String) As String
        Dim connectionString As String = Me.GetConnectionString(dataSourceOrDefaultDir, catalogOrDbq, userID, Password)
        Return Me.InternalImport(connectionString, selectString)
    End Function

End Class

[水如烟]

SqlTranExcel.vb

Public Class SqlTranExcel
    Inherits DbTranExcel

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String) As String
        Return String.Format("ODBC;DRIVER=SQL Server;SERVER={0};DATABASE={1};Trusted_Connection=Yes;", dataSource, database)
    End Function

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String, ByVal userID As String, ByVal Password As String) As String
        Return String.Format("ODBC;DRIVER=SQL Server;SERVER={0};DATABASE={1};uid={2};pwd={3};", dataSource, database, userID, Password)
    End Function

End Class

[水如烟]

AccessTranExcel.vb

'不考虑工作组文件
Public Class AccessTranExcel
    Inherits DbTranExcel

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String) As String
        Return String.Format("ODBC;Driver={{Microsoft Access Driver (*.mdb)}};DefaultDir={0};DBQ={1};uid=admin;", dataSource, database)
    End Function

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String, ByVal userID As String, ByVal Password As String) As String
        Return String.Format("ODBC;DRIVER={{Microsoft Access Driver (*.mdb)}};DefaultDir={0};DBQ={1};uid={2};pwd={3};", dataSource, database, userID, Password)
    End Function

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal mdbFile As String, ByVal selectstring As String) As String
        Return Me.Import(mdbFile, Nothing, selectstring)
    End Function

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal mdbFile As String, ByVal Password As String, ByVal selectString As String) As String
        Return Me.Import(Nothing, mdbFile, "admin", Password, selectString)
    End Function

    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal mdbFile As String, ByVal userID As String, ByVal Password As String, ByVal selectString As String) As String
        Return Me.Import(Nothing, mdbFile, userID, Password, selectString)
    End Function
End Class

[水如烟]

DBaseTranExcel.vb

Public Class DBaseTranExcel
    Inherits DbTranExcel

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String) As String
        Return String.Format("ODBC;DRIVER={{Microsoft dBase Driver (*.dbf)}};DriverId=533;FIL=dBase 5.0;DefaultDir={0};DBQ={1};uid=admin;", dataSource, database)
    End Function

    Protected Overloads Overrides Function GetConnectionString(ByVal dataSource As String, ByVal database As String, ByVal userID As String, ByVal Password As String) As String
        Return String.Format("ODBC;DRIVER={{Microsoft dBase Driver (*.dbf)}};DriverId=533;FIL=dBase 5.0;DefaultDir={0};DBQ={1};uid={2};pwd={3};", dataSource, database, userID, Password)
    End Function


    ''' <summary>
    ''' 如正常,返回为空字符;如异常,返回异常消息
    ''' </summary>
    Public Overloads Function Import(ByVal path As String, ByVal selectstring As String) As String
        Return Me.Import(Nothing, path, selectstring)
    End Function

End Class

[水如烟]

使用方法,以ACCESS为例

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        Dim tran As New AccessTranExcel

        tran.CreateOrOpenWorkbook("C:\Northwind.xls") '确定xls文件
        tran.CreateOrSelectWorksheet("产品") '确定存放数据所在的工作表名称

        Dim mResult As String '存放导出过程的消息

        mResult = tran.Import("C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb", "SELECT * FROM 产品")

        If mResult = "" Then
            Console.WriteLine("成功")
        Else
            Console.WriteLine("失败,原因:" & mResult)
        End If

        tran.Save() '保存
        tran.Close() '关闭excel
    End Sub

[水如烟]

最后,可以做成这样:导出数据库所有的表

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim t As New DatabaseExcel(New SqlDatabase("(local)", "AdventureWorks"))
        t.ImportAllTables()
    End Sub

    Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim t As New DatabaseExcel(New DBaseDatabase("z:\"))
        t.ImportAllTables()
    End Sub

    Private Sub Button3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim t As New DatabaseExcel(New AccessDatabase("g:\test.mdb"))
        t.ImportAllTables()
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        Dim tran As New AccessTranExcel

        tran.CreateOrOpenWorkbook("C:\Northwind.xls") '确定xls文件
        tran.CreateOrSelectWorksheet("产品") '确定存放数据所在的工作表名称

        Dim mResult As String '存放导出过程的消息

        mResult = tran.Import("C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb", "SELECT * FROM 产品")

        If mResult = "" Then
            Console.WriteLine("成功")
        Else
            Console.WriteLine("失败,原因:" & mResult)
        End If

        tran.Save() '保存
        tran.Close() '关闭excel
    End Sub
End Class

[_NET2004]

楼上的绝对是个弓虽人。

[SYUEHOKO]

现在对数据库操作的工具已经很完善了.用这种方式不觉得繁琐吗?

[水如烟]

你不觉得编程就是为了实现自我控制吗?

[bobyang520]

对你的景仰有如滔滔江水绵延不绝！