Code:
Private Sub btnImport_Click()
On Error GoTo error_proc
Dim strImportDataPath As String
Dim strTable As String
Dim intStep As Integer
Dim strProjNum As String
strImportDataPath = "C:\" & Me.tbxFieldFile
'get proj_num from import file
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = New ADODB.Connection
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strImportDataPath)
Set rs = New ADODB.Recordset
rs.Open "SELECT proj_num FROM projects;", cn, adOpenStatic, adLockReadOnly
If rs.RecordCount = 0 Then
MsgBox "No records to import."
ElseIf IsNull(DLookup("proj_num", "projects", "proj_num='" & rs!proj_num & "'")) Then
For intStep = 1 To 4
Select Case intStep
'need table name to use in the INSERT command
Case 1
strTable = "projects"
Case 2
strTable = "co_inputs"
Case 3
strTable = "OverUnder"
Case 4
strTable = "rates"
End Select
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO " & strTable & " SELECT * FROM [" & strImportDataPath & "]." & strTable & ";"
DoCmd.SetWarnings True
Next
Me.Requery
Else
MsgBox "Project number already in database."
End If
exit_proc:
If Not cn Is Nothing Then
Set cn = Nothing
End If
If Not rs Is Nothing Then
Set rs = Nothing
End If
Exit Sub
error_proc:
MsgBox Err.Number & " : " & Err.Description & vbCrLf & vbCrLf & "Import failed, contact administrator."
Resume exit_proc
End Sub
In another I use autonumber as PK:
Code:
Function SaveData(strFile) As String
On Error GoTo errProc:Dim j As Integer, k As Integer
Dim strTable As String, strField As String, lngRec As Long
Dim rsSessions As ADODB.Recordset
Dim rsStations As ADODB.Recordset
Dim rsTransducers As ADODB.Recordset
Dim rsComments As ADODB.Recordset
Dim rsRemarks As ADODB.Recordset
Dim rsDrops As ADODB.Recordset
Dim rsHistories As ADODB.Recordset
Dim rsTimings As ADODB.Recordset
Dim rsDest As ADODB.Recordset
Set rsSessions = New ADODB.Recordset
Set rsStations = New ADODB.Recordset
Set rsTransducers = New ADODB.Recordset
Set rsComments = New ADODB.Recordset
Set rsRemarks = New ADODB.Recordset
Set rsDrops = New ADODB.Recordset
Set rsHistories = New ADODB.Recordset
Set rsTimings = New ADODB.Recordset
Set rsDest = New ADODB.Recordset
SaveData = "Imported"
rsSessions.Open "SELECT * FROM [" & strFile & "].Sessions;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
strTable = "Sessions"
While Not rsSessions.EOF
lngRec = rsSessions!SessionID
rsDest.Open "SELECT * FROM Sessions;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
rsDest.AddNew
For j = 1 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsSessions.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
''CurrentDb.Execute "INSERT INTO SessionStructure(SessionID, StructureID) VALUES(" & DMax("SessionID", "Sessions") & ", '" & Me.lbxStructures & "')"
strTable = "Comments"
rsComments.Open "SELECT * FROM [" & strFile & "].Comments WHERE SessionID=" & rsSessions!SessionID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsComments.EOF
rsDest.Open "SELECT * FROM Comments;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsComments!CommentID
rsDest.AddNew
rsDest!SessionID = DMax("SessionID", "Sessions")
For j = 2 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsComments.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
rsComments.MoveNext
Wend
rsComments.Close
strTable = "Remarks"
rsRemarks.Open "SELECT * FROM [" & strFile & "].Remarks WHERE SessionID=" & rsSessions!SessionID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsRemarks.EOF
rsDest.Open "SELECT * FROM Remarks;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsRemarks!RemarkID
rsDest.AddNew
rsDest!SessionID = DMax("SessionID", "Sessions")
For j = 2 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsRemarks.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
rsRemarks.MoveNext
Wend
rsRemarks.Close
strTable = "Transducers"
rsTransducers.Open "SELECT * FROM [" & strFile & "].Transducers WHERE SessionID=" & rsSessions!SessionID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsTransducers.EOF
rsDest.Open "SELECT * FROM Transducers;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsTransducers!TransducerID
rsDest.AddNew
rsDest!SessionID = DMax("SessionID", "Sessions")
For j = 2 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsTransducers.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
rsTransducers.MoveNext
Wend
rsTransducers.Close
strTable = "Stations"
rsStations.Open "SELECT * FROM [" & strFile & "].Stations WHERE SessionID=" & rsSessions!SessionID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsStations.EOF
rsDest.Open "SELECT * FROM Stations;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsStations!StationID
rsDest.AddNew
rsDest!SessionID = DMax("SessionID", "Sessions")
For j = 2 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsStations.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
strTable = "Drops"
rsDrops.Open "SELECT * FROM [" & strFile & "].Drops WHERE StationID=" & rsStations!StationID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsDrops.EOF
rsDest.Open "SELECT * FROM Drops;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsDrops!DropID
rsDest.AddNew
rsDest!StationID = DMax("StationID", "Stations")
For j = 2 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsDrops.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
strTable = "Histories"
rsHistories.Open "SELECT * FROM [" & strFile & "].Histories WHERE DropID=" & rsDrops!DropID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsHistories.EOF
rsDest.Open "SELECT * FROM Histories;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsHistories!HistoryID
rsDest.AddNew
rsDest!DropID = DMax("DropID", "Drops")
For j = 3 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsHistories.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
rsHistories.MoveNext
Wend
lngRec = 0
rsHistories.Close
strTable = "Timings"
rsTimings.Open "SELECT * FROM [" & strFile & "].Timings WHERE DropID=" & rsDrops!DropID & ";", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsTimings.EOF
rsDest.Open "SELECT * FROM Timings;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
lngRec = rsTimings!TimingID
rsDest.AddNew
rsDest!DropID = DMax("DropID", "Drops")
For j = 3 To rsDest.Fields.Count - 1
strField = rsDest.Fields(j).Name
rsDest.Fields(j) = rsTimings.Fields(rsDest.Fields(j).Name)
Next
strField = ""
rsDest.Update
rsDest.Close
rsTimings.MoveNext
Wend
lngRec = 0
rsTimings.Close
rsDrops.MoveNext
Wend
lngRec = 0
rsDrops.Close
rsStations.MoveNext
Wend
lngRec = 0
rsStations.Close
rsSessions.MoveNext
Wend
lngRec = 0
rsSessions.Close
exitProc:
Exit Function
errProc:
Debug.Print Mid(strFile, InStrRev(strFile, "\") + 1) & " : " & strTable & " : " & strField & " : " & lngRec & " :: " & Err.Number & ":" & Err.Description
SaveData = "Failed"
Resume exitProc:
End Function
If you have only one table to import, process will be much, much simpler.