Copy Tables from Runtime Dataset to Empty Dataset (MDB)

jeremymjackson
jeremymjackson used Ask the Experts™
on
Please help..  Here is what I am trying to accomplish.  I have an application that fills a datagrid based on event calls from the users ( i.e user presses button, application fills empty datagrid with data from specific sql query).  My next task is to take the data in that datagrid and copy it out to a MDB file for portability (user can take that MDB file back to office and extract data at will).  The final step will be to take a set of SQL tables and copy them all out at once to the MDB.  I have an empty MDB in my project and an empty dataset created for it.

When my messagebox pops below I can see the table count has increased, but when I open the MDB the new table is not there??
'Early on I have code that fills the datagrid from a shared SQL Class.
'the datatable that is created is a new datatable named Me.dt
'The empty MDB dataset is me.StoreExportDataSet
 
Private Sub btnFillMDB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillMDB.Click
 
        For Each tbl As DataTable In Me.dt.DataSet.Tables()
            Me.StoreExportDataSet.Tables.Add(tbl.Copy)
        Next
 
        Me.StoreExportDataSet.AcceptChanges()
        MsgBox("TABLE COUNT: " & Me.XStoreExportDataSet.Tables.Count.ToString)
       
  End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
You don't - here - add any tables to Me.XStoreExportDataSet, only to Me.StoreExportDataSet.

/gustav
x77

Commented:
Use Dao or Adox or Create Table (Ado.Net).
I'am using Dao, using PIA included in the system when the user installs MsAccess.
The Create Table option is more compless. We need a function that creates the fields on new table based on DataColumn.
Note that a String Data column translates to Text Field if length <= 256 or Memo.
Some columns types no supported on MsAcces. Sample : Char -> String[1]
The sample, use the more frequent options only. I include new columns based on data calculated.
Also add relations to Exported tables.


  Public Function MSAccessFld(ByVal TD As dao.TableDef, ByVal C As DataColumn) As dao.Field
       Dim FLD As dao.Field = Nothing, Tc = Type.GetTypeCode(C.DataType)
       Select Case Tc
         Case TypeCode.String
              FLD = TD.CreateField(C.ColumnName, If(C.MaxLength > 255 OrElse C.MaxLength < 0, _
                        dao.DataTypeEnum.dbMemo, dao.DataTypeEnum.dbText), _
                        If(C.MaxLength > 0, CObj(C.MaxLength), Reflection.Missing.Value))
         Case TypeCode.DateTime : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbDate)
 
         Case TypeCode.Int16 : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbInteger)
         Case TypeCode.Int32 : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbLong)
 
         Case TypeCode.Single : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbSingle)
         Case TypeCode.Double : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbDouble)
 
         Case TypeCode.Decimal : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbDouble)
 
         Case TypeCode.Char : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbText, 1)
         Case TypeCode.Boolean : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbBoolean)
         Case TypeCode.Byte : FLD = TD.CreateField(C.ColumnName, dao.DataTypeEnum.dbByte)
         Case Else : Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & C.ColumnName)
       End Select
       Return FLD
  End Function
 
 
 
  Public Function MsAccessNewTable(ByVal Db As dao.Database, ByVal Name As String, ByVal DT As DataTable) As dao.TableDef
        Dim T = db.CreateTableDef(Name)
        For Each c As DataColumn In DT.Columns
            T.Fields.Append(MSAccessFld(T, c))
        Next
        Db.TableDefs.Append(T)
        Return T
  End Function
 
 
Private Sub ExportTd(ByVal db As dao.Database)
        'Creación Tabledef Td en MsAccess
        Dim DT As DataTable = Td, T = MsAccessNewTable(db, "Td", DT)
        With T.Fields  'Fechas límite del trabajo asociadas a Dm
             For Each s In "Fimte,Ffmta".Split(","c)
                .Append(T.CreateField(s, dao.DataTypeEnum.dbDate))
             Next
        End With
 
        'RecordSet's para grabar los datos
        Dim N As Integer, a As Cpm.ActCpm
 
       'Añadir Datos Trabajo a TD
        Dim R As DataRow, HTT As New HTStr(Trabajos.Count) 'Lista de CodTra añadidos a TD - HashTable
        Dim rs = T.OpenRecordset(dao.RecordsetTypeEnum.dbOpenTable, dao.RecordsetOptionEnum.dbAppendOnly)
        Dim NCols = Td.Columns.Count - 1
        For Each Trabajo In Trabajos
            HTT.add(Trabajo.Codtra)
            rs.AddNew()
            R = Trabajo.Row
            For N = 0 To NCols
                rs(N).Value = R(N)
            Next
            Dim Dm = TryCast(R(cdm), String)
            a = If(Dm Is Nothing, Nothing, PrjCpm(Dm))
            If a IsNot Nothing Then
               rs(N).Value = CDate(a.fimte) : N += 1
               rs(N).Value = CDate(a.ffmte) ': N += 1
            End If
            rs.Update()
        Next
        rs.Close()
 
        'Creación Tabledef TdPos en MsAccess
        DT = TdPos : T = MsAccessNewTable(db, "TdPos", DT)
        rs = T.OpenRecordset(dao.RecordsetTypeEnum.dbOpenTable, dao.RecordsetOptionEnum.dbAppendOnly)
        NCols = TdPos.Columns.Count - 1
        For Each R In TdPos.Rows
            If HTT.Contains(DirectCast(R(cPosCodTRa), String)) Then _
               rs.AddNew() : For N = 0 To NCols : rs(N).Value = R(N) : Next : rs.Update()
        Next
        rs.Close()
 
        'Constraints
        Dim Sql As String = Nothing
        Try
            For Each Sql In New String() { _
                "Alter Table Td ADD CONSTRAINT PrimaryKey Primary Key(CODTRA)", _
                "Alter table TdPos ADD CONSTRAINT TdPos FOREIGN KEY(CodTra) References Td "}
              db.Execute(Sql)
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message, Sql)
        End Try
End Sub
 
Private Sub mExportTd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mExportTd.Click
        Dim f As New SaveFileDialog, Ruta = Path.Combine(My.Settings.RutaDatos, "MDB")
        Dim dbe As dao.DBEngine = Nothing, Db As dao.Database = Nothing
        Try
            Cursor = Cursors.WaitCursor
            If Directory.Exists(Ruta) = False Then Directory.CreateDirectory(Ruta)
            f.InitialDirectory = Ruta
            f.Filter = "B.Datos.Acces (*.Mdb)|*.Mdb"
            f.DefaultExt = "Mdb"
            f.FileName = Path.Combine(Ruta, "TD.Mdb")
            If f.ShowDialog() = Windows.Forms.DialogResult.OK Then
               Dim fname = f.FileName, Fi = New FileInfo(fname)
               If Fi.Exists Then Fi.Delete()
                  Application.DoEvents()
                  dbe = New dao.DBEngine
                  Db = dbe.CreateDatabase(fname, dao.LanguageConstants.dbLangGeneral, dao.DatabaseTypeEnum.dbVersion40)
                  ExportTd(Db)
            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Exportando a Access")
        Finally
            If Db IsNot Nothing Then Db.Close()
            If dbe IsNot Nothing Then dbe.Workspaces(0).Close()
            Cursor = Cursors.Default
        End Try
End Sub

Open in new window

Most Valuable Expert 2012
Top Expert 2014

Commented:
There are two ways of doing this

1) You have the DataTables in memory. You can loop through the rows and execute Insert statements to add the rows to Access.

2) You can configure a dataset with datatable with Access. Then copy the rows to that dataset and use Update method to save changes.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

x77

Commented:
I Tested a solution without interop (oledb).
It is about 30 times slower than Dao solution.
  Public Shared Function ExportDsToMsAccess(ByVal Name As String, ByVal DT As DataTable, ByVal db As OleDb.OleDbConnection) As Boolean
        Dim Sb As New StringBuilder(500)
        Sb.Append("Create Table [").Append(Name).Append("] (")
        For Each c As DataColumn In DT.Columns
           Dim Tc = Type.GetTypeCode(c.DataType)
           Sb.Append(c.ColumnName).Append(" "c)
           Select Case Tc
             Case TypeCode.String
                  If c.MaxLength > 255 OrElse c.MaxLength < 0 _
                     Then Sb.Append("LONGTEXT") _
                     Else Sb.AppendFormat("Text({0})", c.MaxLength)
             Case TypeCode.DateTime : Sb.Append("DateTime")
             Case TypeCode.Int16 : Sb.Append("SHORT")
             Case TypeCode.Int32 : Sb.Append("INT")
             Case TypeCode.Single : Sb.Append("REAL")
             Case TypeCode.Double : Sb.Append("FLOAT")
             Case TypeCode.Decimal : Sb.Append("NUMBER")
             Case TypeCode.Char : Sb.Append("Text(1)")
             Case TypeCode.Boolean : Sb.Append("BIT")
             Case TypeCode.Byte : Sb.Append("BYTE")
             Case Else : Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & c.ColumnName)
           End Select
           Sb.Append(","c)
        Next
        Sb.Chars(Sb.Length - 1) = ")"c
        Try
           Dim cmd As New OleDb.OleDbCommand(Sb.ToString, db)
           cmd.ExecuteNonQuery()
           'Sb.Length = 0
           'Sb.Append("Insert into [").Append(Name).Append("] Values(")
           'For n = 1 To DT.Columns.Count : Sb.Append("?,") : Next
           'Sb.Chars(Sb.Length - 1) = ")"c
           'cmd = New OleDb.OleDbCommand(Sb.ToString, db)
           'cmd.Prepare()
           Dim t As New Stopwatch
           t.Start()
           'For Each r As DataRow In DT.Rows
             'For n = 0 To DT.Columns.Count - 1 : cmd.Parameters.Add(New OleDb.OleDbParameter(Nothing, r(n))) : Next
             'cmd.ExecuteNonQuery()
             'cmd.Parameters.Clear()
           'Next
           For Each r As DataRow In DT.Rows : r.SetAdded() : Next
           Dim da As New OleDb.OleDbDataAdapter("Select * from " & Name, db)
           Dim cb As New OleDb.OleDbCommandBuilder(da)
           da.Update(DT)
           t.Stop()
           Debug.Print(t.Elapsed.ToString)
        Catch ex As Exception
           MessageBox.Show(ex.Message, "Creating Ms Acces Table " & Name)
           Debug.Print(Sb.ToString)
           Return False
        End Try
        Return True
  End Function

Open in new window

Author

Commented:
x77.  I am testing your latest solution without interop.  My first problem was a column type issue.  The first column in my DT was a GUID type.  This threw the type not implimented error.  Is there a way to convert this to TEXT in your code?  Testing past this I removed that column from my query.  Now I consistently get a syntax error in field definition.  Although I can take the query that your code produces and run it directly against my Access DB with no errors.  I have attached the query that is produced.
Create Table [USERS] (type TEXT,name TEXT,login TEXT,password TEXT,title TEXT,phone TEXT,extension TEXT,emailAddress TEXT,isAdministrator INT,inactivated INT)

Open in new window

x77

Commented:
The Type Guid not implements IConvertible. - No TypeCode.
DataAdapter, no converts it.
             Case Else
                 If c.DataType Is GetType(Guid) Then
                     Sb.Append("Text(50)")
                 Else
                     Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & c.ColumnName)
                 End If
 
 
 
           For Each r As DataRow In DT.Rows
             For n = 0 To DT.Columns.Count - 1
                 Dim v = r(n)
                 If TypeOf (v) Is Guid Then v = v.ToString
                 cmd.Parameters.Add(New OleDb.OleDbParameter(Nothing, v)) : Next
             cmd.ExecuteNonQuery()
             cmd.Parameters.Clear()
           Next

Open in new window

x77

Commented:
I can get the insert command with the apropiate parameters from commandbuilder.
do not need SetAdded
           Dim da As New OleDb.OleDbDataAdapter("Select * from " & Name, db)
           Dim cb As New OleDb.OleDbCommandBuilder(da)
           cmd = cb.GetInsertCommand
           
           For Each r As DataRow In DT.Rows
             For n = 0 To DT.Columns.Count - 1
                 Dim v = r(n)
                 If TypeOf (v) Is Guid Then v = v.ToString
                 cmd.Parameters(n).Value = v
             Next
             cmd.ExecuteNonQuery()
           Next

Open in new window

Author

Commented:
X77,

Below is my new code, with your changes.  The code is throwing an exception citing a Syntax Error when it is trying to executenonquery on the Create Table.
Public Shared Function ExportDsToMsAccess(ByVal Name As String, ByVal DT As DataTable, ByVal db As OleDb.OleDbConnection) As Boolean
        Dim Sb As New StringBuilder(500)
        Sb.Append("Create Table [").Append(Name).Append("] (")
        For Each c As DataColumn In DT.Columns
            Dim Tc = Type.GetTypeCode(c.DataType)
            Sb.Append(c.ColumnName).Append(" "c)
            Select Case Tc
                Case TypeCode.String
                    If c.MaxLength > 255 OrElse c.MaxLength < 0 _
                    Then Sb.Append("LONGTEXT") _
                    Else Sb.AppendFormat("Text({0})", c.MaxLength)
                Case TypeCode.DateTime : Sb.Append("DateTime")
                Case TypeCode.Int16 : Sb.Append("SHORT")
                Case TypeCode.Int32 : Sb.Append("INT")
                Case TypeCode.Single : Sb.Append("REAL")
                Case TypeCode.Double : Sb.Append("FLOAT")
                Case TypeCode.Decimal : Sb.Append("NUMBER")
                Case TypeCode.Char : Sb.Append("Text(1)")
                Case TypeCode.Boolean : Sb.Append("BIT")
                Case TypeCode.Byte : Sb.Append("BYTE")
                    'Case Else : Throw New Exception(Tc.ToString & " Type Not Implimented, Column: " & c.ColumnName)
                Case Else
                    If c.DataType Is GetType(Guid) Then
                        Sb.Append("Text(50)")
                    Else
                        Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & c.ColumnName)
                    End If
            End Select
            Sb.Append(","c)
        Next
        Sb.Chars(Sb.Length - 1) = ")"c
        Try
            Dim cmd As New OleDb.OleDbCommand(Sb.ToString, db)
            cmd.ExecuteNonQuery()
            Sb.Length = 0
            Sb.Append("Insert into [").Append(Name).Append("] Values(")
            For n = 1 To DT.Columns.Count : Sb.Append("?,") : Next
            Sb.Chars(Sb.Length - 1) = ")"c
            cmd = New OleDb.OleDbCommand(Sb.ToString, db)
            cmd.Prepare()
            Dim t As New Stopwatch
            t.Start()
            For Each r As DataRow In DT.Rows
                For n = 0 To DT.Columns.Count - 1 : cmd.Parameters.Add(New OleDb.OleDbParameter(Nothing, r(n))) : Next
                cmd.ExecuteNonQuery()
                cmd.Parameters.Clear()
            Next
            For Each r As DataRow In DT.Rows : r.SetAdded() : Next
            Dim da As New OleDb.OleDbDataAdapter("Select * from " & Name, db)
            Dim cb As New OleDb.OleDbCommandBuilder(da)
            da.Update(DT)
            t.Stop()
            Debug.Print(t.Elapsed.ToString)
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Creating Ms Acces Table " & Name)
            Debug.Print(Sb.ToString)
            Return False
        End Try
        Return True
    End Function

Open in new window

x77

Commented:
I Tested with Provider=Microsoft.ACE.OLEDB.12.0;
and               Provider=Microsoft.Jet.OLEDB.4.0;

   Dim dt As New DataTable
   dt.Columns.Add(New DataColumn("G1", GetType(Guid)))
   dt.Columns.Add(New DataColumn("a", GetType(String)) With {.MaxLength = 25})
   dt.Columns.Add(New DataColumn("b", GetType(String)) With {.MaxLength = 1024})
   dt.Columns.Add(New DataColumn("c", GetType(Byte)))
   dt.Columns.Add(New DataColumn("d", GetType(Short)))
   dt.Columns.Add(New DataColumn("e", GetType(Int32)))
   dt.Columns.Add(New DataColumn("f", GetType(Double)))
   dt.Columns.Add(New DataColumn("g", GetType(Single)))
   dt.Columns.Add(New DataColumn("h", GetType(Decimal)))
   dt.Columns.Add(New DataColumn("i", GetType(Date)))
   Dim r = dt.NewRow
   Dim g = Guid.NewGuid
   r(0) = g
   dt.Rows.Add(r)
   Debug.Print(g.ToString)
   ExportDsToMsAccess("T3", dt, dB)

Note. supress lines 35-40, 43-47 if use CommandBuilder.
  Public Shared Function ExportDsToMsAccess(ByVal Name As String, ByVal DT As DataTable, ByVal db As OleDb.OleDbConnection) As Boolean
        Dim Sb As New StringBuilder(500)
        Sb.Append("Create Table [").Append(Name).Append("] (")
        For Each c As DataColumn In DT.Columns
           Dim Tc = Type.GetTypeCode(c.DataType)
           Sb.Append(c.ColumnName).Append(" "c)
           Select Case Tc
             Case TypeCode.String
                  If c.MaxLength > 255 OrElse c.MaxLength < 0 _
                     Then Sb.Append("LONGTEXT") _
                     Else Sb.AppendFormat("Text({0})", c.MaxLength)
             Case TypeCode.DateTime : Sb.Append("DateTime")
             Case TypeCode.Int16 : Sb.Append("SHORT")
             Case TypeCode.Int32 : Sb.Append("INT")
             Case TypeCode.Single : Sb.Append("REAL")
             Case TypeCode.Double : Sb.Append("FLOAT")
             Case TypeCode.Decimal : Sb.Append("NUMBER")
             Case TypeCode.Char : Sb.Append("Text(1)")
             Case TypeCode.Boolean : Sb.Append("BIT")
             Case TypeCode.Byte : Sb.Append("BYTE")
             Case Else
                 If c.DataType Is GetType(Guid) Then
                     Sb.Append("Text(50)")
                 Else
                     Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & c.ColumnName)
                 End If
           End Select
           Sb.Append(","c)
        Next
        Sb.Chars(Sb.Length - 1) = ")"c
        Try
           Dim cmd As New OleDb.OleDbCommand(Sb.ToString, db)
           cmd.ExecuteNonQuery()
 
   
           Dim da As New OleDb.OleDbDataAdapter("Select * from " & Name, db)
           Dim cb As New OleDb.OleDbCommandBuilder(da)
           cmd = cb.GetInsertCommand
           
           Dim t As New Stopwatch
           t.Start()
           For Each r As DataRow In DT.Rows
             For n = 0 To DT.Columns.Count - 1
                 Dim v = r(n)
                 If TypeOf (v) Is Guid Then v = v.ToString
                 cmd.Parameters(n).Value = v
             Next
             cmd.ExecuteNonQuery()
           Next
 
           t.Stop()
           Debug.Print(t.Elapsed.ToString)
 
        Catch ex As Exception
           MessageBox.Show(ex.Message, "Creating Ms Acces Table " & Name)
           Debug.Print(Sb.ToString)
           Return False
        End Try
        Return True
  End Function

Open in new window

x77

Commented:
To suppress the table if it exists, insert drop statement before the try:

        Try
            Dim cmd As New OleDb.OleDbCommand("Drop Table " & Name, db)
            cmd.ExecuteNonQuery()
        Catch ex As Exception
        End Try
        Try
           Dim cmd As New OleDb.OleDbCommand(Sb.ToString, db)
           cmd.ExecuteNonQuery()


Commented:
The Field PassWord fails in OleDb. In MsAccess do not give me error.
I Enclosed it by "[", "]"
  Public Shared Function ExportDsToMsAccess(ByVal Name As String, ByVal DT As DataTable, ByVal db As OleDb.OleDbConnection) As Boolean
        Dim Sb As New StringBuilder(500)
        Sb.Append("Create Table [").Append(Name).Append("] (")
        For Each c As DataColumn In DT.Columns
           Dim Tc = Type.GetTypeCode(c.DataType)
           Sb.Append("[").Append(c.ColumnName).Append("]").Append(" "c)
           Select Case Tc
             Case TypeCode.String
                  If c.MaxLength > 255 OrElse c.MaxLength < 0 _
                     Then Sb.Append("LONGTEXT") _
                     Else Sb.AppendFormat("Text({0})", c.MaxLength)
             Case TypeCode.DateTime : Sb.Append("DateTime")
             Case TypeCode.Int16 : Sb.Append("SHORT")
             Case TypeCode.Int32 : Sb.Append("INT")
             Case TypeCode.Single : Sb.Append("REAL")
             Case TypeCode.Double : Sb.Append("FLOAT")
             Case TypeCode.Decimal : Sb.Append("NUMBER")
             Case TypeCode.Char : Sb.Append("Text(1)")
             Case TypeCode.Boolean : Sb.Append("BIT")
             Case TypeCode.Byte : Sb.Append("BYTE")
             Case Else
                 If c.DataType Is GetType(Guid) Then
                     Sb.Append("Text(50)")
                 Else
                     Throw New Exception(Tc.ToString & " Tipo no Implementado, Columna: " & c.ColumnName)
                 End If
           End Select
           Sb.Append(","c)
        Next
        Sb.Chars(Sb.Length - 1) = ")"c
        Try
            Dim cmd As New OleDb.OleDbCommand("Drop Table " & Name, db)
            cmd.ExecuteNonQuery()
        Catch ex As Exception
        End Try
        Try
           Dim cmd As New OleDb.OleDbCommand(Sb.ToString, db)
           cmd.ExecuteNonQuery()
 
   
           Dim da As New OleDb.OleDbDataAdapter("Select * from " & Name, db)
           Dim cb As New OleDb.OleDbCommandBuilder(da)
           cmd = cb.GetInsertCommand
           Sb.Length = 0
           Sb.Append("Insert into [").Append(Name).Append("] Values(")
           For n = 1 To DT.Columns.Count : Sb.Append("?,") : Next
           Sb.Chars(Sb.Length - 1) = ")"c
           cmd.CommandText = Sb.ToString
 
           Dim t As New Stopwatch
           t.Start()
           For Each r As DataRow In DT.Rows
             For n = 0 To DT.Columns.Count - 1
                 Dim v = r(n)
                 If TypeOf (v) Is Guid Then v = v.ToString
                 cmd.Parameters(n).Value = v
             Next
             cmd.ExecuteNonQuery()
           Next
 
           t.Stop()
           Debug.Print(t.Elapsed.ToString)
 
        Catch ex As Exception
           MessageBox.Show(ex.Message, "Creating Ms Acces Table " & Name)
           Debug.Print(Sb.ToString)
           Return False
        End Try
        Return True
  End Function

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial