Here are procedures combined for one pass through CSV. I am sure code could be refined but it does work.
Code:
Dim objDB As dao.Database
Dim mylog As dao.Recordset
Dim mylog2 As dao.Recordset
Dim fso As New FileSystemObject
Dim Tst As TextStream
Dim strline As String
Dim strFilePath As String
Dim Strfilename As String
Dim strInfile As String
Dim operator As String
Dim Username As String
Dim ArrayOperator() As String
Dim MyArray() As String
Dim file_name As String
Dim rundate As String
Dim Date_Tested As Date
Dim DateTime_Tested As Date
Dim temp_str As String
Dim iPos As Integer
Dim iEnd As Integer
Dim i As Integer
Dim MyArray1() As String
Set objDB = CurrentDb()
objDB.Execute "DELETE FROM ABI;", dbFailOnError
objDB.Execute "DELETE FROM thermal", dbFailOnError
strInfile = "\\project\ABI_testing\CSV_files\"
Strfilename = "Sea_testing.csv"
strFilePath = strInfile & Strfilename
'open recordset
Set mylog = objDB.OpenRecordset("ABI")
Set mylog2 = objDB.OpenRecordset("thermal")
i = 1
' Reading .CSV file and add new records to tables
If fso.FileExists(strFilePath) Then 'If 1
Set Tst = fso.OpenTextFile(strFilePath, ForReading, False)
Do Until Tst.AtEndOfStream 'Do 1
iPos = 0
' Reading .CSV file and creating ABI table Add a new record
strline = Tst.ReadLine
iPos = InStr(strline, ":")
If iPos > 0 And i < 20 Then 'If 2
temp_str = Left(strline, iPos + 0)
Select Case temp_str
Case "Document Name:"
file_name = Trim(Replace(Mid(strline, InStr(strline, ":") + 1), ",", ""))
Case "User:"
Username = Trim(Replace(Mid(strline, InStr(strline, ":") + 1), ",", ""))
If Trim(Username) = "xx9" Then 'If 3
operator = "Reporter 1"
ElseIf Trim(Username) = "kkk2" Then 'If 3
operator = "Reporter 2"
End If 'If 3
ArrayOperator = Split(operator, " ")
Case "Run Date:"
rundate = Trim(Mid(strline, iPos + 1))
temp_str = ""
temp_str = Right(rundate, 1)
Do Until temp_str <> ","
If Right(rundate, 1) = "," Then 'If 4
rundate = Left(rundate, Len(rundate) - 1)
temp_str = Right(rundate, 1)
End If 'If 4
Loop
Date_Tested = DateValue(Mid([rundate], InStr([rundate], ",") + 2))
DateTime_Tested = CVDate(Mid([rundate], InStr([rundate], ",") + 1))
Case "Last Modified:"
'do nothing
End Select
ElseIf Left(strline, 4) = "Well" Then 'If 5
'check if at "Well Data" line
Do Until Tst.AtEndOfStream 'Do 2
strline = Tst.ReadLine
temp_str = Mid(strline, InStr(strline, ":") + 1)
MyArray = Split(temp_str, ",")
mylog.AddNew
mylog![Run_file_Name] = file_name
mylog![Username] = Username
mylog![operator] = operator
mylog![Tester] = Left(ArrayOperator(0), 1) & ArrayOperator(1)
mylog![rundate] = rundate
mylog![Date_Tested] = Date_Tested
mylog![DateTime_Tested] = DateTime_Tested
mylog![SampleID] = UCase(MyArray(1))
If IsNumeric(MyArray(1)) Then 'If 6
mylog![ID_NUMBER] = MyArray(1)
Else 'If 6
mylog![ID_NUMBER] = 0
End If 'If 6
mylog.Update
Loop 'Do 2
ElseIf (i > 19) And (i <= 23) And strline <> "Standard 7500 Mode" Then
MyArray1 = Split(strline, ",")
MsgBox strline
mylog2.AddNew
If IsNumeric(MyArray1(0)) Then
mylog2![Stage] = UCase(MyArray1(0))
Else
mylog2![Stage] = 0
End If
If IsNumeric(MyArray1(0)) Then
mylog2![Temperature] = UCase(MyArray1(2))
Else
mylog2![Temperature] = 0
End If
mylog2![Time_t] = UCase(MyArray1(3))
mylog2![Ramp_Rate] = UCase(MyArray1(4))
mylog2![Auto_Increment] = UCase(MyArray1(5))
mylog2.Update
End If
i = i + 1
Loop 'Do 1
End If 'If 1
'clean up
On Error Resume Next
Tst.Close
mylog.Close
mylog2.Close
Set mylog = Nothing
Set mylog2 = Nothing
Set fso = Nothing
Set objDB = Nothing
MsgBox "Done"
However, there may be something wrong with code for Thermal data. There are 6 headers but Repetitions column is not referenced in code and there are no values under Auto_Increment.
Will Stage always be a number?
Consider this alternate approach:
Code:
' Reading .CSV file and add new records to tables
Dim objDB As dao.Database
Dim mylog As dao.Recordset
Dim fso As New FileSystemObject
Dim strFilePath As String
Dim file_name As String
Dim Username As String
Dim rundate As String
Dim i As Integer
Dim MyArray As Variant
Dim strT As String
Set objDB = CurrentDb()
objDB.Execute "DELETE FROM ABI;", dbFailOnError
objDB.Execute "DELETE FROM thermal", dbFailOnError
strFilePath = "\\project\ABI_testing\CSV_files\Sea_testing.csv"
Set mylog = objDB.OpenRecordset("ABI")
If fso.FileExists(strFilePath) Then
strT = fso.OpenTextFile(strFilePath, ForReading, False).ReadAll
MyArray = Split(Left(strT, InStr(strT, "Instrument Type:") - 1), vbCrLf)
file_name = Trim(Replace(Mid(MyArray(0), InStr(MyArray(0), ":") + 1), ",", ""))
Username = Trim(Replace(Mid(MyArray(2), InStr(MyArray(2), ":") + 1), ",", ""))
rundate = Trim(Mid(MyArray(7), InStr(MyArray(7), ":") + 1))
ReDim MyArray(0)
MyArray = Split(Mid(strT, InStr(strT, "Well,")), vbCrLf)
For i = 1 To UBound(MyArray) - 1
mylog.AddNew
mylog![Run_file_Name] = file_name
mylog![Username] = Username
mylog![operator] = "Reporter " & Switch(Username = "xx9", "1", Username = "kkk2", "2")
mylog![Tester] = "R" & Switch(Username = "xx9", "1", Username = "kkk2", "2")
mylog![rundate] = Left(rundate, Len(rundate) - 3)
mylog![Date_Tested] = DateValue(Replace(Mid(rundate, InStr(rundate, ",") + 1), ",", ""))
mylog![DateTime_Tested] = CDate(Replace(Mid(rundate, InStr(rundate, ",") + 1), ",", ""))
mylog![SampleID] = UCase(Split(MyArray(i), ",")(1))
mylog![ID_NUMBER] = Val(UCase(Split(MyArray(i), ",")(1)))
mylog.Update
Next
mylog.Close
Set mylog = objDB.OpenRecordset("thermal")
ReDim MyArray(0)
MyArray = Split(Mid(Left(strT, InStr(strT, "Standard 7500") - 1), InStr(strT, "Stage")), vbCrLf)
For i = 1 To UBound(MyArray) - 1
mylog.AddNew
mylog![Stage] = Val(Split(MyArray(i), ",")(0))
mylog![Temperature] = UCase(Split(MyArray(i), ",")(2))
mylog![Time_t] = UCase(Split(MyArray(i), ",")(3))
mylog![Ramp_Rate] = UCase(Split(MyArray(i), ",")(4))
'mylog![Auto_Increment] = UCase(Split(MyArray(i), ",")(5))
mylog.Update
Next
End If