PDA

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



wengan
11-07-2006, 12:07 AM
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

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