Public Sub transferdata()
'set up connection
Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Dim mytbl As AccessObject
'set up variables to hold the parsed values of the table name holding imported data
Dim mypart As String
Dim myrev As String
Dim myjob As String
Dim myop As String
Dim mysn As String
'set up variable that will hold the position number of the spaces in the table names
Dim firstspaceposition As Long
Dim secondspaceposition As Long
Dim thirdspaceposition As Long
Dim fourthspaceposition As Long
Dim fifthspaceposition As Long
Dim holdpartpk As Long
Dim holdjobpk As Long
Dim holdpartrevpk As Long
'loop through the table names to find the imported tables; ignore system tables and tables beginning with tbl
For Each mytbl In CurrentData.AllTables
If Not Left(mytbl.Name, 4) = "Msys" Then
If Not Left(mytbl.Name, 3) = "tbl" Then
'if an imported table is found, parse out the names into their respective variables
firstspaceposition = InStr(1, mytbl.Name, " ")
secondspaceposition = InStr(firstspaceposition + 1, mytbl.Name, " ")
thirdspaceposition = InStr(secondspaceposition + 1, mytbl.Name, " ")
fourthspaceposition = InStr(thirdspaceposition + 1, mytbl.Name, " ")
fifthspaceposition = InStr(fourthspaceposition + 1, mytbl.Name, " ")
mypart = Mid(mytbl.Name, 1, firstspaceposition)
myrev = Mid(mytbl.Name, firstspaceposition + 1, secondspaceposition - 1 - firstspaceposition + 1)
myop = Mid(mytbl.Name, secondspaceposition + 1, thirdspaceposition - 1 - secondspaceposition + 1)
myjob = Mid(mytbl.Name, thirdspaceposition + 1, fourthspaceposition - 1 - thirdspaceposition + 1)
mysn = Mid(mytbl.Name, fourthspaceposition + 1, fifthspaceposition - 1 - fourthspaceposition + 1)
'check to see if the job has been previously created if so get pk; if not create new
If DCount("*", "tblJobs", "txtJobNo='" & myjob & "'") > 0 Then
holdjobpk = DLookup("pkJobID", "tblJobs", "txtJobNo='" & myjob & "'")
Else
Dim myrecset1 As New ADODB.Recordset
myrecset1.ActiveConnection = cnn1
myrecset1.Open "tblJobs", , adOpenDynamic, adLockOptimistic
With myrecset1
.AddNew
!txtJobNo = myjob
holdjobpk = !pkJobID
.Update
.Close
End With
Set myrecset1 = Nothing
End If
'check to see if the part has been previously created if so get pk; if not create new
If DCount("*", "tblParts", "txtPartNo='" & mypart & "'") > 0 Then
holdpartpk = DLookup("pkPartID", "tblParts", "txtPartNo='" & mypart & "'")
Else
Dim myrecset2 As New ADODB.Recordset
myrecset2.ActiveConnection = cnn1
myrecset2.Open "tblParts", , adOpenDynamic, adLockOptimistic
With myrecset2
.AddNew
!txtPartNo = mypart
holdpartpk = !pkPartID
.Update
.Close
End With
Set myrecset2 = Nothing
End If
'check to see if the rev for the part has been previously created if so get pk; if not create new
If DCount("*", "tblPartRev", "fkPartID=" & holdpartpk & " AND txtrev='" & myrev & "'") > 0 Then
holdpartrevpk = DLookup("pkPartRevID", "tblPartRev", "fkPartID=" & holdpartpk & " AND txtrev='" & myrev & "'")
Else
Dim myrecset3 As New ADODB.Recordset
myrecset3.ActiveConnection = cnn1
myrecset3.Open "tblPartRev", , adOpenDynamic, adLockOptimistic
With myrecset3
.AddNew
!txtRev = myrev
!fkPartID = holdpartpk
holdpartrevpk = !pkPartRevID
.Update
.Close
End With
Set myrecset3 = Nothing
End If
'check to see if the operation has been previously created if so get pk; if not create new
If DCount("*", "tblOperations", "txtOperationNo='" & myop & "'") > 0 Then
holdoppk = DLookup("pkOpID", "tblOperations", "txtOperationNo='" & myop & "'")
Else
Dim myrecset4 As New ADODB.Recordset
myrecset4.ActiveConnection = cnn1
myrecset4.Open "tblOperations", , adOpenDynamic, adLockOptimistic
With myrecset4
.AddNew
!txtOperationNo = myop
holdoppk = !pkOpID
.Update
.Close
End With
Set myrecset4 = Nothing
End If
'check to see if the part rev & operation junction record has been previously created if so get pk; if not create new
If DCount("*", "tblPartRevOps", "fkPartRevID=" & holdpartrevpk & " AND fkOpID=" & holdoppk) > 0 Then
holdpartrevopspk = DLookup("pkPartRevOpsID", "tblPartRevOps", "fkPartRevID=" & holdpartrevpk & " AND fkOpID=" & holdoppk)
Else
Dim myrecset5 As New ADODB.Recordset
myrecset5.ActiveConnection = cnn1
myrecset5.Open "tblPartRevOps", , adOpenDynamic, adLockOptimistic
With myrecset5
.AddNew
!fkPartrevID = holdpartrevpk
!fkOpID = holdoppk
holdpartrevopspk = !pkPartRevOpsID
.Update
.Close
End With
Set myrecset5 = Nothing
End If
'check to see if the job part record has been previously created if so get pk; if not create new
If DCount("*", "tblJobParts", "fkJobID=" & holdjobpk & " AND fkPartRevID=" & holdpartrevpk) > 0 Then
holdjobpartpk = DLookup("pkJobPartID", "tblJobParts", "fkJobID=" & holdjobpk & " AND fkPartRevID=" & holdpartrevpk)
Else
Dim myrecset7 As New ADODB.Recordset
myrecset7.ActiveConnection = cnn1
myrecset7.Open "tblJobParts", , adOpenDynamic, adLockOptimistic
With myrecset7
.AddNew
!fkJobID = holdjobpk
!fkPartrevID = holdpartrevpk
holdjobpartpk = !pkJobPartID
.Update
.Close
End With
Set myrecset7 = Nothing
End If
'check to see if the piece record has been previously created if so get pk; if not create new
If DCount("*", "tblPieces", "fkJobPartID=" & holdjobpartpk & " AND txtSerialNo='" & mysn & "'") > 0 Then
holdpiecepk = DLookup("pkPieceID", "tblPieces", "fkJobPartID=" & holdjobpartpk & " AND txtSerialNo='" & mysn & "'")
Else
Dim myrecset8 As New ADODB.Recordset
myrecset8.ActiveConnection = cnn1
myrecset8.Open "tblPieces", , adOpenDynamic, adLockOptimistic
With myrecset8
.AddNew
!txtSerialNo = mysn
!fkJobPartID = holdjobpartpk
holdpiecepk = !pkPieceID
.Update
.Close
End With
Set myrecset8 = Nothing
End If
End If
End If
'reset the variables for the next table
firstspaceposition = 0
secondspaceposition = 0
thirdspaceposition = 0
fourthspaceposition = 0
fifthspaceposition = 0
mypart = ""
myrev = ""
myjob = ""
myop = ""
mysn = ""
Next mytbl
End Sub
