Attribute VB_Name = "basReadText"
Option Compare Database

Function ReadText_Extractor(ByVal strFileText)
Dim strCurrentTable
Dim fso As New FileSystemObject
Set f = fso.OpenTextFile(strFileText)

Do While Not f.AtEndOfLine
    strLine = f.ReadLine
    If UCase(Left(strLine, 5)) = "TABEL" Then
       strCurrentTable = strLine
       If Not isTableExist(strLine) Then
          Call CreateTable(strLine)
       End If
    Else
       x = Split(strLine, "~")
       If jCountField(strCurrentTable) < UBound(x) + 1 Then
          
            For i = jCountField(strCurrentTable) To 10
                 strSQL = "ALTER TABLE " & strCurrentTable & " ADD COLUMN F" & i & " TEXT(50)"
                 Call RunSQL(strSQL)
            Next
            
            If x(0) = "N" Then
                 strSQL = "INSERT INTO " & strCurrentTable & "(F1) VALUES ('" & x(0) & "')"
                 Call RunSQL(strSQL)
            
                For j = 2 To UBound(x) + 1
                     strSQL = "UPDATE " & strCurrentTable & " SET F" & j & " = '" & x(j - 1) & "'"
                     Debug.Print strSQL
                     Call RunSQL(strSQL)
                Next
            End If
       Else
                 
            If x(0) = "N" Then
                For j = 1 To UBound(x) + 1
                    If j = 1 Then
                       strSQL = "INSERT INTO " & strCurrentTable & "(F1) VALUES ('" & x(0) & "')"
                       Call RunSQL(strSQL)
                    Else
                       strSQL = "UPDATE " & strCurrentTable & " SET F" & j & " = '" & x(j - 1) & "' WHERE RecID =" & jLastID(strCurrentTable)
                       Call RunSQL(strSQL)
                    End If
                Next
            End If
       End If
    End If
Loop

Set fso = Nothing

End Function

Function CreateTable(ByVal strTableName As String)
    strSQL = "CREATE TABLE " & strTableName & "(RecID COUNTER) "
    Call RunSQL(strSQL)
End Function

Function RunSQL(ByVal strSQL As String)
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL, True
    DoCmd.SetWarnings True
End Function

Function isTableExist(ByVal strTableName As String) As Boolean

isTableExist = False
    Dim tdf As DAO.TableDef
    For Each tdf In CurrentDb.TableDefs
        If tdf.Name = strTableName Then
           isTableExist = True
           Exit For
        End If
    Next
    Set tdf = Nothing

End Function

Function jCountField(ByVal strTableName As String) As Integer
    jCountField = CurrentDb.TableDefs(strTableName).Fields.Count
End Function

Function testReadText()
    Call DeleteAllTable
    Call ReadText_Extractor(CurrentProject.Path & "\DataRaw.txt")
    Call ConvertAllTables_To_DBF
End Function

Function DeleteAllTable()
    Dim tdf As DAO.TableDef
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.Name, 5) = "Tabel" Then
           CurrentDb.TableDefs.Delete tdf.Name
        End If
    Next
End Function


Function jLastID(ByVal strTableName) As Integer
    Dim rst As DAO.Recordset
    strSQL = "SELECT " & strTableName & ".RecID FROM " & strTableName & " Order By RecID DESC"
    
    Set rst = CurrentDb.OpenRecordset(strSQL)
    jLastID = rst(0)
    
    Set rst = Nothing
End Function


Function ConvertAllTables_To_DBF()
    Dim tdf As DAO.TableDef
    For Each tdf In CurrentDb.TableDefs
        If UCase(Left(tdf.Name, 5)) = "TABEL" Then
            DoCmd.TransferDatabase acExport, "dBase 5.0", "C:\Temp", acTable, tdf.Name, tdf.Name & ".dbf", False
        End If
    Next
End Function