• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Data Transfer from SQL Server / MS Access to Excel

Data Transfer from SQL Server / MS Access to Excel

Data Transfer from SQL Server / MS Access to Excel

Rate Data Transfer from SQL Server / MS Access to Excel

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    Private Tbl As DataTable
    Private Col As DataColumn
    Private Row As DataRow

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        ExcelApp = New Excel.Application()
        ExcelApp.Application.Workbooks.Add(True)

    End Sub

    Private Function GetData() As System.Data.DataTable

        Dim OleCon As New System.Data.OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\Program Files\Microsoft Visual Studio\VB98\NWIND.MDB")
        Dim OleAdapter As New System.Data.OleDb.OleDbDataAdapter("SELECT * FROM Customers ORDER BY CustomerID", OleCon)
        Dim OleDataSet As New System.Data.DataSet()

        OleAdapter.Fill(OleDataSet, "Customers")
        Return OleDataSet.Tables("Customers")

    End Function

    Private Sub CmdTransfer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdTransfer.Click

        Try
            Me.Cursor = Cursors.WaitCursor

            Dim ColIndex As Integer = 0
            Dim RowIndex As Integer = 1

            Tbl = New DataTable("Customers")
            Tbl = GetData()
            Col = New DataColumn()

            For Each Col In Tbl.Columns()
                ColIndex += 1
                ExcelApp.Cells(1, ColIndex) = Col.ColumnName.ToString()
            Next

            Prg1.Value = 0
            Prg1.Maximum = Tbl.Rows.Count

            For Each Row In Tbl.Rows
                RowIndex += 1
                ColIndex = 0
                For Each Col In Tbl.Columns()
                    ColIndex += 1
                    ExcelApp.Cells(RowIndex, ColIndex) = Row(Col.ColumnName).ToString()
                    ExcelApp.Columns.AutoFit()
                Next Col
                Prg1.Value += 1
                Application.DoEvents()
            Next Row

            ExcelApp.Visible = True
            Me.Cursor = Cursors.Default

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Me.Cursor = Cursors.Default
        End Try
    End Sub