Consulting

Results 1 to 1 of 1

Thread: Get data from access in vb 2005 and save it as a new excel sheet

  1. #1
    VBAX Newbie
    Joined
    Nov 2006
    Posts
    1
    Location

    Get data from access in vb 2005 and save it as a new excel sheet

    i need to do an application that takes data from access and save it as a new excel file . Any help would be appreciated. A simple program like this, i use this button to start the search and then the rest of it, i am stuck

    [VBA]PrivateSub btnAnalyze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAnalyze.Click
    Me.Cursor = Cursors.WaitCursor
    System.Windows.Forms.Application.DoEvents()
    ' Open Excel and create a new workbook.
    Dim excel_app AsNew Excel.Application
    excel_app.Visible = True
    Dim excel_workbook As Excel.Workbook = _
    excel_app.Workbooks.Add()
    Dim excel_worksheet As Excel.Worksheet = _
    DirectCast(excel_workbook.Sheets(1), Excel.Worksheet)
    excel_worksheet.Range("A1", "Z1").Columns.ColumnWidth = 20
    ' Examine the tables.
    Dim row_num AsInteger = 1
    ' Section heading.
    excel_worksheet.Cells(row_num, 1) = "Tables"
    With excel_worksheet.Range("A" & row_num).Font
    .Size = 25
    .Bold = True
    .Color = RGB(255, 0, 0)
    EndWith
    row_num += 1
    ' Open the database connection.
    DBConn.ConnectionString = _
    "Provider=""Microsoft.Jet.OLEDB.4.0"";" & _
    "Data Source=""" & txtDatabase.Text & """;" & _
    "Mode=Share Deny None;" & _
    "persist security info=False;"
    DBConn.Open()
    ' Get schema information for TABLE type tables only.
    ' This excludes access and system tables.
    Dim dt_table As System.Data.DataTable = _
    DBConn.GetOleDbSchemaTable( _
    OleDb.OleDbSchemaGuid.Tables, _
    NewObject() {Nothing, Nothing, Nothing, "TABLE"})
    ' Loop over the tables.
    ForEach dr_table As DataRow In dt_table.Rows
    ' Display the table's name in the form's title bar.
    Dim table_name AsString = dr_table("TABLE_NAME").ToString
    Me.Text = "MDBAnalyzer: " & table_name
    System.Windows.Forms.Application.DoEvents()
    ' Display the table's name, description, date created, and date modified.
    excel_worksheet.Cells(row_num, 1) = table_name
    With excel_worksheet.Range("A" & row_num).Font
    .Size = 20
    .Bold = True
    .Color = RGB(0, 0, 255)
    EndWith
    row_num += 1
    If dr_table.IsNull("DESCRIPTION") Then
    excel_worksheet.Cells(row_num, 1) = "<no description>"
    Else
    excel_worksheet.Cells(row_num, 1) = dr_table("DESCRIPTION").ToString
    EndIf
    row_num += 1
    excel_worksheet.Cells(row_num, 1) = "Created:"
    excel_worksheet.Cells(row_num, 2) = dr_table("DATE_CREATED").ToString
    row_num += 1
    excel_worksheet.Cells(row_num, 1) = "Modified:"
    excel_worksheet.Cells(row_num, 2) = dr_table("DATE_MODIFIED").ToString
    row_num += 1
    ' Subsection header.
    excel_worksheet.Cells(row_num, 1) = "Fields"
    With excel_worksheet.Range("A" & row_num).Font
    .Size = 16
    .Bold = True
    .Color = RGB(0, 128, 255)
    EndWith
    row_num += 1
    ' Get the table's field data.
    Dim dt_field As System.Data.DataTable = _
    DBConn.GetOleDbSchemaTable( _
    OleDb.OleDbSchemaGuid.Columns, _
    NewObject() {Nothing, Nothing, table_name})
    ' Headers.
    Dim field_properties() AsString = Split("Name,Type,Char Length,Is Nullable,DefaultValue,Description", ",")
    For col_num AsInteger = 0 To field_properties.Length - 1
    excel_worksheet.Cells(row_num, col_num + 1) = field_properties(col_num)
    Next col_num
    With excel_worksheet.Range("A" & row_num, "Z" & row_num).Font
    .Bold = True
    EndWith
    row_num += 1
    ' Display the table's field's information.
    ForEach dr_field As DataRow In dt_field.Rows
    ' Name.
    excel_worksheet.Cells(row_num, 1) = dr_field("COLUMN_NAME").ToString
    ' Type.
    Dim ole_db_type As OleDb.OleDbType = _
    CType(dr_field("DATA_TYPE"), OleDb.OleDbType)
    excel_worksheet.Cells(row_num, 2) = ole_db_type.ToString
    excel_worksheet.Cells(row_num, 3) = dr_field("CHARACTER_MAXIMUM_LENGTH").ToString
    excel_worksheet.Cells(row_num, 4) = dr_field("IS_NULLABLE").ToString
    IfCBool(dr_field("COLUMN_HASDEFAULT").ToString) Then _
    excel_worksheet.Cells(row_num, 5) = dr_field("COLUMN_DEFAULT").ToString
    IfNot dr_field.IsNull("DESCRIPTION") Then
    excel_worksheet.Cells(row_num, 6) = dr_field("DESCRIPTION").ToString
    EndIf
    row_num += 1
    Next dr_field
    ' Subsection header.
    excel_worksheet.Cells(row_num, 1) = "Indexes"
    With excel_worksheet.Range("A" & row_num).Font
    .Size = 16
    .Bold = True
    .Color = RGB(0, 128, 255)
    EndWith
    row_num += 1
    ' Get the table's index data.
    Dim dt_index As System.Data.DataTable = _
    DBConn.GetOleDbSchemaTable( _
    OleDb.OleDbSchemaGuid.Indexes, _
    NewObject() {Nothing, Nothing, Nothing, Nothing, table_name})
    ' Headers.
    Dim index_properties() AsString = Split("Name,Primary,Unique,Column", ",")
    For col_num AsInteger = 0 To index_properties.Length - 1
    excel_worksheet.Cells(row_num, col_num + 1) = index_properties(col_num)
    Next col_num
    With excel_worksheet.Range("A" & row_num, "Z" & row_num).Font
    .Bold = True
    EndWith
    row_num += 1
    ' Display the table's index's information.
    ForEach dr_index As DataRow In dt_index.Rows
    excel_worksheet.Cells(row_num, 1) = dr_index("INDEX_NAME").ToString
    excel_worksheet.Cells(row_num, 2) = dr_index("PRIMARY_KEY").ToString
    excel_worksheet.Cells(row_num, 3) = dr_index("UNIQUE").ToString
    excel_worksheet.Cells(row_num, 4) = dr_index("COLUMN_NAME").ToString
    row_num += 1
    Next dr_index
    Next dr_table
    ' Foreign keys.
    ' Section heading.
    excel_worksheet.Cells(row_num, 1) = "Foreign Keys"
    With excel_worksheet.Range("A" & row_num).Font
    .Size = 25
    .Bold = True
    .Color = RGB(255, 0, 0)
    EndWith
    row_num += 1
    ' Foreign keys.
    Dim dt_fkeys As System.Data.DataTable = _
    DBConn.GetOleDbSchemaTable( _
    OleDb.OleDbSchemaGuid.Foreign_Keys, Nothing)
    ' Headers.
    Dim fkeys_properties() AsString = Split("Primary Column,Foreign Column,Primary Key,Foreign Key,Update Rule,Delete Rule", ",")
    For col_num AsInteger = 0 To fkeys_properties.Length - 1
    excel_worksheet.Cells(row_num, col_num + 1) = fkeys_properties(col_num)
    Next col_num
    With excel_worksheet.Range("A" & row_num, "Z" & row_num).Font
    .Bold = True
    EndWith
    row_num += 1
    ' Display foreign key data.
    ForEach dr_fkeys As DataRow In dt_fkeys.Rows
    excel_worksheet.Cells(row_num, 1) = _
    dr_fkeys("PK_TABLE_NAME").ToString & "." & _
    dr_fkeys("PK_COLUMN_NAME").ToString
    excel_worksheet.Cells(row_num, 2) = _
    dr_fkeys("FK_TABLE_NAME").ToString & "." & _
    dr_fkeys("FK_COLUMN_NAME").ToString
    excel_worksheet.Cells(row_num, 3) = dr_fkeys("PK_NAME").ToString
    excel_worksheet.Cells(row_num, 4) = dr_fkeys("FK_NAME").ToString
    excel_worksheet.Cells(row_num, 5) = dr_fkeys("UPDATE_RULE").ToString
    excel_worksheet.Cells(row_num, 6) = dr_fkeys("DELETE_RULE").ToString
    row_num += 1
    Next dr_fkeys
    excel_worksheet = Nothing
    excel_workbook = Nothing
    excel_app = Nothing
    DBConn.Close()
    Me.Text = "Done"
    Me.Cursor = Cursors.Default
    MessageBox.Show("Done", "Done", MessageBoxButtons.OK, MessageBoxIcon.Information)
    EndSub[/VBA]
    Last edited by wengan; 11-07-2006 at 12:28 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •