Hello all.
I am hoping I could get some suggestions on moving forward.
My Challenge: Importing data from one table to another where the field
names almost never match.
My Form has a list box, [lstSelectTable] (this is the FROM table), that
lists tables in the currentDb.
Also, multiple comboboxes [a] to [z] and [aa] to [zz].
When a table is selected in [lstSelectTable] comboboxes [a] thru [z] a
filled with field names from [lstSelectTable].
The TO table is static "tImportTemp"
Comboboxes [aa] thru [zz] are filled with field names from
"tImportTemp"
What I would like to happen is
Copy the data represented in field [a] into the field represented in
field [aa], into [bb]. [c] into [cc]..... all the way to [z] into [zz]
ANY suggestions on how to move forward are appreciated.
Detrie
Here is the code that works great right now. This will copy data from
the table selected in [lstSelectTable] into "tImportTemp" ONLY if the
field names match...
START CODE...
Private Sub cmdCopy_Click()
Dim db As DAO.Database
Dim rs_fr As DAO.Recordset
Dim rs_to As DAO.Recordset
Dim fields_fr() As DAO.Field
Dim fields_to() As DAO.Field
Dim field_fr As DAO.Field
Dim field_to As DAO.Field
Dim num_fields As Integer
Dim i As Integer
Dim num_copied As Long
' Open the database.
Set db = CurrentDb
db.Execute "DELETE FROM " & "timporttemp" ' This empties the "to" table
before starting.
' Open the tables.
Set rs_fr = db.OpenRecordset(Me!lstSelectTable)
Set rs_to = db.OpenRecordset("timporttemp")
' Find the fields that match in the two tables.
num_fields = 0
For Each field_fr In rs_fr.Fields
' Get the matching field in the "to" table.
On Error Resume Next
Set field_to = rs_to.Fields(field_fr.Name)
If Err.Number <> 0 Then Set field_to = Nothing
On Error GoTo 0
If Not (field_to Is Nothing) Then
' Save the matching fields.
num_fields = num_fields + 1
ReDim Preserve fields_fr(1 To num_fields)
ReDim Preserve fields_to(1 To num_fields)
Set fields_fr(num_fields) = field_fr
Set fields_to(num_fields) = field_to
lstFields.AddItem field_fr.Name
End If
Next field_fr
' Copy the records.
num_copied = 0
Do Until rs_fr.EOF
' Make a new record.
rs_to.AddNew
' Copy the field values.
For i = 1 To num_fields
fields_to(i).Value = fields_fr(i).Value
Next i
rs_to.update
rs_fr.MoveNext
num_copied = num_copied + 1
Loop
rs_fr.Close
rs_to.Close
db.Close
MsgBox "Copied " & num_copied & " records"
End Sub
END CODE
I am hoping I could get some suggestions on moving forward.
My Challenge: Importing data from one table to another where the field
names almost never match.
My Form has a list box, [lstSelectTable] (this is the FROM table), that
lists tables in the currentDb.
Also, multiple comboboxes [a] to [z] and [aa] to [zz].
When a table is selected in [lstSelectTable] comboboxes [a] thru [z] a
filled with field names from [lstSelectTable].
The TO table is static "tImportTemp"
Comboboxes [aa] thru [zz] are filled with field names from
"tImportTemp"
What I would like to happen is
Copy the data represented in field [a] into the field represented in
field [aa], into [bb]. [c] into [cc]..... all the way to [z] into [zz]
ANY suggestions on how to move forward are appreciated.
Detrie
Here is the code that works great right now. This will copy data from
the table selected in [lstSelectTable] into "tImportTemp" ONLY if the
field names match...
START CODE...
Private Sub cmdCopy_Click()
Dim db As DAO.Database
Dim rs_fr As DAO.Recordset
Dim rs_to As DAO.Recordset
Dim fields_fr() As DAO.Field
Dim fields_to() As DAO.Field
Dim field_fr As DAO.Field
Dim field_to As DAO.Field
Dim num_fields As Integer
Dim i As Integer
Dim num_copied As Long
' Open the database.
Set db = CurrentDb
db.Execute "DELETE FROM " & "timporttemp" ' This empties the "to" table
before starting.
' Open the tables.
Set rs_fr = db.OpenRecordset(Me!lstSelectTable)
Set rs_to = db.OpenRecordset("timporttemp")
' Find the fields that match in the two tables.
num_fields = 0
For Each field_fr In rs_fr.Fields
' Get the matching field in the "to" table.
On Error Resume Next
Set field_to = rs_to.Fields(field_fr.Name)
If Err.Number <> 0 Then Set field_to = Nothing
On Error GoTo 0
If Not (field_to Is Nothing) Then
' Save the matching fields.
num_fields = num_fields + 1
ReDim Preserve fields_fr(1 To num_fields)
ReDim Preserve fields_to(1 To num_fields)
Set fields_fr(num_fields) = field_fr
Set fields_to(num_fields) = field_to
lstFields.AddItem field_fr.Name
End If
Next field_fr
' Copy the records.
num_copied = 0
Do Until rs_fr.EOF
' Make a new record.
rs_to.AddNew
' Copy the field values.
For i = 1 To num_fields
fields_to(i).Value = fields_fr(i).Value
Next i
rs_to.update
rs_fr.MoveNext
num_copied = num_copied + 1
Loop
rs_fr.Close
rs_to.Close
db.Close
MsgBox "Copied " & num_copied & " records"
End Sub
END CODE
