Need help with next step of creating Import Form (see code)

  • Thread starter Thread starter EiEiO
  • Start date Start date
E

EiEiO

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.


EiEiO


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
 
Why not link or import to temp table and then use an append query. You can
append any field to any field as long as the datatype matches.
 
Thanks for your reply..
I thought about that but the users will not have the technical ability
to create and run queries
 
Back
Top