Rank 2
Basically this will allow you to take a specified Access DB and move all the tables and all the data in those tables to a SQL Server DB of your choice. The real beauty of this is that it allows you to combine several access DBs into a single SQL Server DB - provided there are no duplicate table names throughout the Access DBs. This is good for remote hosting accounts that usually only let you have a single DB whereas multiple Access DBs were commonplace. It would be prudent for the DBA to check the new database and setup the relationships / constraints, as well as to mark any identity (autonumber) columns in the new DB (it does NOT do this now because it would never be able to copy the foreign key relationships if the IDs weren't kept the same). Anyways, here it is...
Imports Microsoft.VisualBasic
Imports System.Data
Imports System.Data.OleDb
Imports System.Data.SqlClient
Public Class ConvertAccessToSqlServer2005
Public Sub Convert()
' Connection to current dbCode
Dim db As New DbCon
' Declare SQL String to be used elsewhere
Dim strSQL As String = ""
' Declare the connection to the Sql Server 2005 Database
Dim SqlCon As New SqlConnection(ConfigurationManager.ConnectionStrings("LocalSqlServer").ConnectionString)
' Retreive all the table names from the Access Database
Dim AccessCon As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=|DataDirectory|ACCESSDBNAME.mdb;Persist Security Info=True")
Dim dtAccessTables As New DataTable
AccessCon.Open()
dtAccessTables = AccessCon.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, "TABLE"})
AccessCon.Close()
' For each table, drop & create the table in SQL Server 2005
For Each rTable As DataRow In dtAccessTables.Rows
strSQL = "DROP TABLE [" & rTable("TABLE_NAME") & "]"
db.dbExecuteNonQuery(strSQL)
' Get the schema for every table
Dim dtTableInfo As New DataTable
Dim AccessDap As New OleDbDataAdapter("SELECT TOP 1 * FROM [" & rTable("TABLE_NAME") & "]", AccessCon)
AccessDap.FillSchema(dtTableInfo, SchemaType.Mapped)
Dim name, type, length As String
Dim COLS As String = ""
' Get column information for every table
For Each c As DataColumn In dtTableInfo.Columns
name = c.ColumnName
type = c.DataType.Name
length = c.MaxLength
Select Case type
Case "String"
If c.MaxLength > 255 Then
type = "text"
Else
type = "nvarchar(" & c.MaxLength & ")"
End If
Case "Boolean"
type = "bit"
Case "DateTime"
type = "datetime"
Case Else
type = "int"
End Select
' Leave Auto-Incrementing alone to allow for the data to be properly copied
' Unique columns are always Primary Keys in my databases
If c.Unique = True Then
If c.AllowDBNull = True Then ' HIGHLY unlikely
COLS += "[" & name & "] " & type & " PRIMARY KEY,"
Else
COLS += "[" & name & "] " & type & " PRIMARY KEY NOT NULL,"
End If
Else
If c.AllowDBNull = True Then
COLS += "[" & name & "] " & type & ","
Else
COLS += "[" & name & "] " & type & " NOT NULL,"
End If
End If
Next
' Create the table in Sql Server 2005
strSQL = "CREATE TABLE [" & rTable("TABLE_NAME") & "] (" & Left(COLS, COLS.Length - 1) & ")"
db.dbExecuteNonQuery(strSQL)
' Get all the table data from Access
Dim dtTableData As New DataTable
AccessDap = New OleDbDataAdapter("SELECT * FROM [" & rTable("TABLE_NAME") & "]", AccessCon)
AccessDap.Fill(dtTableData)
' Copy each row to Sql Server 2005
For Each r As DataRow In dtTableData.Rows
Dim Columns As String = ""
Dim Values As String = ""
For Each c As DataColumn In dtTableData.Columns
If Not r.IsNull(c.ColumnName) Then
Columns += "[" & c.ColumnName & "],"
Select Case c.DataType.Name
Case "String"
Values += db.qc(r(c.ColumnName))
Case "Boolean"
Values += db.bc(r(c.ColumnName))
Case "DateTime"
Values += db.dc(r(c.ColumnName))
Case Else
Values += db.c(r(c.ColumnName))
End Select
End If
Next
strSQL = "INSERT INTO [" & rTable("TABLE_NAME") & "] (" & Left(Columns, Columns.Length - 1) & ") VALUES (" & Left(Values, Values.Length - 1) & ")"
db.dbExecuteNonQuery(strSQL)
Next
Next
End Sub
End Class
Imports System.Web.Security
Imports System.Data
Imports System.Data.SqlClient
Public Class DbCon
Public Function dbGetDataset(ByVal strSQL As String) As DataSet
Dim dbCon As SqlConnection = New SqlConnection(ConfigurationManager.ConnectionStrings("localSqlServer").ConnectionString)
Dim dbDap As New SqlDataAdapter(strSQL, dbCon)
Dim dstReturn As New DataSet
Try
dbDap.Fill(dstReturn)
Return dstReturn
Catch ex As Exception
Return Nothing
End Try
End Function
Public Function dbExecuteNonQuery(ByVal strSQL As String) As String
Dim dbCon As SqlConnection = New SqlConnection(ConfigurationManager.ConnectionStrings("localSqlServer").ConnectionString)
Dim dbCmd As New SqlCommand(strSQL, dbCon)
Try
dbCon.Open()
Dim intReturn As Integer = dbCmd.ExecuteNonQuery()
dbCon.Close()
dbCon.Dispose()
If InStr(strSQL.ToUpper, "@@IDENTITY") Then ' Return the new Identity
Return intReturn
Else
If intReturn = 1 Then
Return "Success"
Else
Return intReturn & " records affected"
End If
End If
Catch ex As Exception
dbCon.Close()
dbCon.Dispose()
Return ex.Message
End Try
End Function
Public Function dbExecuteScalar(ByVal strSQL As String) As Object
Dim dbCon As SqlConnection = New SqlClient.SqlConnection(ConfigurationManager.ConnectionStrings("localSqlServer").ConnectionString)
Dim dbCmd As New SqlCommand(strSQL, dbCon)
Try
dbCon.Open()
Dim ojReturn As Object = dbCmd.ExecuteScalar
dbCon.Close()
dbCon.Dispose()
Return ojReturn
Catch ex As Exception
dbCon.Close()
dbCon.Dispose()
Return ex.Message
End Try
End Function ' Returns the first column from the first row based on the SQL String
Public Function q(ByVal strField As String) As String
Return " '" & strField.Replace("'", "''") & "'"
End Function ' Quotations, Replace Apostrophe, No Comma
Public Function qc(ByVal strField As String) As String
Return " '" & strField.Replace("'", "''") & "',"
End Function ' Quotations, Replace Apostrophe, Comma
Public Function c(ByVal dblField As Double) As String
Return " " & dblField & ","
End Function ' Comma
Public Function d(ByVal datField As Date) As String
Return " '" & datField & "'"
End Function ' Date, No Comma
Public Function dc(ByVal datField As Date) As String
Return " '" & datField & "',"
End Function ' Date, Comma
Public Function b(ByVal blnField As Boolean) As String
If blnField = True Then
Return " " & 1 & ""
Else
Return " " & 0 & ""
End If
End Function ' Boolean, No Comma
Public Function bc(ByVal blnField As Boolean) As String
If blnField = True Then
Return " " & 1 & ","
Else
Return " " & 0 & ","
End If
End Function ' Boolean, Comma
End Class
Enjoy!
4 Answers, 1 is accepted
Rank 2
Protected Sub Move(ByVal TableName As String)
Try
'Create source connection Using SQL but could be Oracle or OLEDb etc...
Dim source As New SqlClient.SqlConnection(Fromstring)
'Create destination connection
Dim destination As New SqlClient.SqlConnection(DestString)
'Your destination database must have the table which schema which you are copying data to.
Dim cmd As SqlClient.SqlCommand
'Open source and destination connections.
source.Open()
destination.Open()
'Select data from table
cmd = New SqlClient.SqlCommand("SELECT * FROM " & TableName, source)
'Execute reader
Dim reader As SqlClient.SqlDataReader = cmd.ExecuteReader()
'Create SqlBulkCopy
Dim bulkdata As SqlClient.SqlBulkCopy = New SqlClient.SqlBulkCopy(destination)
'Set destination table name
bulkdata.DestinationTableName = TableName
'Write data all in one shot, instead of single insert statements
bulkdata.WriteToServer(reader)
'Close objects
bulkdata.Close()
destination.Close()
source.Close()
'Dispose
destination.Dispose()
source.Dispose()
reader = Nothing
bulkdata = Nothing
Catch ex As Exception
'handle your exception here:
End Try
End Sub
Rank 2
Rank 2
Al
Rank 2
Thanks Al.
I guess the next step to polishing this off would be to figure out a way to get all the contraints / relationships from the source table and re-create them in the destination table after all the data has been copied. Anybody got something that does that already?