Hi,
I have 2 Access databases (A & B) and I need to be able to transfer the data from a table in database A to a table (same name) in database B.
It is not an append, I want the data from the table in database A to overwrite the existing data on the table in B.
I have tried the following:
Public gwsMainWS As Workspace
Public gdbCurrent As Database
'------------------------------------------------------------
'this function copies the structure of one table to
'a new table in the same or different database
'------------------------------------------------------------
Function CopyStruct(vFromDB As Database, vToDB As Database, vFromName As String, vToName As String, bCreateIndex As Integer) As Integer
On Error GoTo CSErr
Dim i As Integer
Dim tblTableDefObj As TableDef
Dim fldFieldObj As Field
Dim indIndexObj As Index
Dim tdf As TableDef
Dim fld As Field
Dim idx As Index
' For Each tdf In vToDB.Tabledefs
For i = 0 To vToDB.TableDefs.Count - 1
Set tdf = vToDB.TableDefs(i)
If UCase(tdf.Name) = UCase(vToName) Then
vToDB.TableDefs.Delete tdf.Name
If Len(vToName) = 0 Then
Exit Function
End If
Exit For
End If
Next
Set tblTableDefObj = gdbCurrent.CreateTableDef()
'strip off owner if needed
tblTableDefObj.Name = vToName
'create the fields
' For Each fld In vFromDB.Tabledefs(vFromName).Fields
For i = 0 To vFromDB.TableDefs(vFromName).Fields.Count - 1
Set fld = vFromDB.TableDefs(vFromName).Fields(i)
Set fldFieldObj = vFromDB.TableDefs(vFromName).CreateField(fld.Name, fld.Type)
tblTableDefObj.Fields.Append fldFieldObj
Next
'create the indexes
If bCreateIndex <> False Then
' For Each idx In vFromDB.Tabledefs(vFromName).Indexes
For i = 0 To vFromDB.TableDefs(vFromName).Indexes.Count - 1
Set idx = vFromDB.TableDefs(vFromName).Indexes(i)
Set indIndexObj = vFromDB.TableDefs(vFromName).CreateIndex(idx.Name)
With indIndexObj
indIndexObj.Fields = idx.Fields
indIndexObj.Unique = idx.Unique
If gsDataType <> gsSQLDB Then
indIndexObj.Primary = idx.Primary
End If
End With
tblTableDefObj.Indexes.Append indIndexObj
Next
End If
'append the new table
vToDB.TableDefs.Append tblTableDefObj
CopyStruct = True
Exit Function
CSErr:
ShowError
CopyStruct = False
End Function
'------------------------------------------------------------
'this function copies data from one table to another
'from the frmCopyStruct form
'It demonstrates the use of transactions to speed up this
'type of operation
'------------------------------------------------------------
Function CopyData(rFromDB As Database, rToDB As Database, rFromName As String, rToName As String) As Integer
' On Error GoTo CopyErr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim i As Integer
Dim nRC As Integer
Dim fld As Field
'open both recordsets
Set recRecordset1 = rFromDB.OpenRecordset(rFromName)
Set recRecordset2 = rToDB.OpenRecordset(rToName)
gwsMainWS.BeginTrans
While recRecordset1.EOF = False
recRecordset2.AddNew
'this loop copies the data from each field to
'the new table
' For Each fld In recRecordset1.Fields
For i = 0 To recRecordset1.Fields.Count - 1
Set fld = recRecordset1.Fields(i)
recRecordset2(fld.Name).Value = fld.Value
Next
recRecordset2.Update
recRecordset1.MoveNext
nRC = nRC + 1
'this test will commit transactions every 1000 records
If nRC = 1000 Then
gwsMainWS.CommitTrans
gwsMainWS.BeginTrans
nRC = 0
End If
Wend
gwsMainWS.CommitTrans
CopyData = True
Exit Function
CopyErr:
gwsMainWS.Rollback
ShowError
CopyData = False
End Function
Private Sub btnSubmit_Click()
' Declare variables
Dim lResponse As Long
Dim dbSlaugh As Database
Dim dbEarnings As Database
Dim rstSlaugh As Recordset
Dim rstEarnings As Recordset
Dim tdfTmsemp As New TableDef
Dim dbsource As Database
Dim dbdest As Database
' Create Microsoft Jet Workspace object.
Set gwsMainWS = CreateWorkspace("", "admin", "", dbUseJet)
Set gdbCurrent = gwsMainWS.OpenDatabase("\\SERVER\DatabaseA.mdb", True)
Set dbsource = gwsMainWS.OpenDatabase("\\SERVER\DatabaseA.mdb", True, True)
Set dbdest = gwsMainWS.OpenDatabase("\\SERVER\DatabaseB.mdb", True, False)
Call CopyStruct(dbsource, dbdest, "Source Table", "Dest Table", True)
Call CopyData(dbsource, dbdest, "Source Table", "Dest Table"
gwsMainWS.Close
gdbCurrent.Close
dbsource.Close
dbdest.Close
End If
End If
End Sub
The line in Bold (in Function CopyStruct) shows where I am getting a type mismatch error. I dunno were this is coming from?
Any Ideas??
P
I have 2 Access databases (A & B) and I need to be able to transfer the data from a table in database A to a table (same name) in database B.
It is not an append, I want the data from the table in database A to overwrite the existing data on the table in B.
I have tried the following:
Public gwsMainWS As Workspace
Public gdbCurrent As Database
'------------------------------------------------------------
'this function copies the structure of one table to
'a new table in the same or different database
'------------------------------------------------------------
Function CopyStruct(vFromDB As Database, vToDB As Database, vFromName As String, vToName As String, bCreateIndex As Integer) As Integer
On Error GoTo CSErr
Dim i As Integer
Dim tblTableDefObj As TableDef
Dim fldFieldObj As Field
Dim indIndexObj As Index
Dim tdf As TableDef
Dim fld As Field
Dim idx As Index
' For Each tdf In vToDB.Tabledefs
For i = 0 To vToDB.TableDefs.Count - 1
Set tdf = vToDB.TableDefs(i)
If UCase(tdf.Name) = UCase(vToName) Then
vToDB.TableDefs.Delete tdf.Name
If Len(vToName) = 0 Then
Exit Function
End If
Exit For
End If
Next
Set tblTableDefObj = gdbCurrent.CreateTableDef()
'strip off owner if needed
tblTableDefObj.Name = vToName
'create the fields
' For Each fld In vFromDB.Tabledefs(vFromName).Fields
For i = 0 To vFromDB.TableDefs(vFromName).Fields.Count - 1
Set fld = vFromDB.TableDefs(vFromName).Fields(i)
Set fldFieldObj = vFromDB.TableDefs(vFromName).CreateField(fld.Name, fld.Type)
tblTableDefObj.Fields.Append fldFieldObj
Next
'create the indexes
If bCreateIndex <> False Then
' For Each idx In vFromDB.Tabledefs(vFromName).Indexes
For i = 0 To vFromDB.TableDefs(vFromName).Indexes.Count - 1
Set idx = vFromDB.TableDefs(vFromName).Indexes(i)
Set indIndexObj = vFromDB.TableDefs(vFromName).CreateIndex(idx.Name)
With indIndexObj
indIndexObj.Fields = idx.Fields
indIndexObj.Unique = idx.Unique
If gsDataType <> gsSQLDB Then
indIndexObj.Primary = idx.Primary
End If
End With
tblTableDefObj.Indexes.Append indIndexObj
Next
End If
'append the new table
vToDB.TableDefs.Append tblTableDefObj
CopyStruct = True
Exit Function
CSErr:
ShowError
CopyStruct = False
End Function
'------------------------------------------------------------
'this function copies data from one table to another
'from the frmCopyStruct form
'It demonstrates the use of transactions to speed up this
'type of operation
'------------------------------------------------------------
Function CopyData(rFromDB As Database, rToDB As Database, rFromName As String, rToName As String) As Integer
' On Error GoTo CopyErr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim i As Integer
Dim nRC As Integer
Dim fld As Field
'open both recordsets
Set recRecordset1 = rFromDB.OpenRecordset(rFromName)
Set recRecordset2 = rToDB.OpenRecordset(rToName)
gwsMainWS.BeginTrans
While recRecordset1.EOF = False
recRecordset2.AddNew
'this loop copies the data from each field to
'the new table
' For Each fld In recRecordset1.Fields
For i = 0 To recRecordset1.Fields.Count - 1
Set fld = recRecordset1.Fields(i)
recRecordset2(fld.Name).Value = fld.Value
Next
recRecordset2.Update
recRecordset1.MoveNext
nRC = nRC + 1
'this test will commit transactions every 1000 records
If nRC = 1000 Then
gwsMainWS.CommitTrans
gwsMainWS.BeginTrans
nRC = 0
End If
Wend
gwsMainWS.CommitTrans
CopyData = True
Exit Function
CopyErr:
gwsMainWS.Rollback
ShowError
CopyData = False
End Function
Private Sub btnSubmit_Click()
' Declare variables
Dim lResponse As Long
Dim dbSlaugh As Database
Dim dbEarnings As Database
Dim rstSlaugh As Recordset
Dim rstEarnings As Recordset
Dim tdfTmsemp As New TableDef
Dim dbsource As Database
Dim dbdest As Database
' Create Microsoft Jet Workspace object.
Set gwsMainWS = CreateWorkspace("", "admin", "", dbUseJet)
Set gdbCurrent = gwsMainWS.OpenDatabase("\\SERVER\DatabaseA.mdb", True)
Set dbsource = gwsMainWS.OpenDatabase("\\SERVER\DatabaseA.mdb", True, True)
Set dbdest = gwsMainWS.OpenDatabase("\\SERVER\DatabaseB.mdb", True, False)
Call CopyStruct(dbsource, dbdest, "Source Table", "Dest Table", True)
Call CopyData(dbsource, dbdest, "Source Table", "Dest Table"
gwsMainWS.Close
gdbCurrent.Close
dbsource.Close
dbdest.Close
End If
End If
End Sub
The line in Bold (in Function CopyStruct) shows where I am getting a type mismatch error. I dunno were this is coming from?
Any Ideas??
P