I have a module which reads a CSV transaction file line by line and adds the correct transactions to an access table and places the wrong ones in a logfile.
Now some transactions are rejected twice there is even one rejected six times. Whereas one wrong transaction is processed only once. I am certainly overlooking something obvious in the logic but what. Here is the relevant code.
Now some transactions are rejected twice there is even one rejected six times. Whereas one wrong transaction is processed only once. I am certainly overlooking something obvious in the logic but what. Here is the relevant code.
Code:
Function ImportCSVForConfederation(inputCSV, ORG)
Dim TNO As Integer, TACT As Integer, TABLE As String, TLINE As String, I As Integer, J As Integer, K As Integer
Dim FLD1 As String, FLD2 As String, FLD3 As String, FLD4 As String, LogFile As String, LogPath As String
Dim Lim As String, ITNO As Integer
On Error GoTo Err_Exit
LogPath = Left(inputCSV, InStrRev(inputCSV, "/", -1))
LogFile = LogPath + "LogFile.txt"
Debug.Print "LogFile="; LogFile; " inputCSV="; inputCSV; " ORG="; ORG
Lim = ","
I = 0
J = 0
K = 0
TNO = 1
TACT = 1
TABLE = inputCSV
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'open input
TNO = 2
TACT = 4
TABLE = LogFile
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'open output
'-----------------------------------------------------------------------------------------------------------------
' Lets read input first line, accept it if it is header
'------------------------------------------------------------------------------------------------------------------
TNO = 1
TACT = 2
TABLE = inputCSV
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'read input first line
If IdentifyFields(TLINE, FLD1, FLD2, FLD3, FLD4, Lim) = 1 Then
MsgBox "Header accepted"
Else
MsgBox "Header rejected"
Exit Function
End If
Dim rstrans As DAO.Recordset
Dim JDEL As Integer
Dim JADD As Integer
Dim JUPD As Integer
Lim = ","
JDEL = 0
JADD = 0
JUPD = 0
Set rstrans = CurrentDb.OpenRecordset("TransTbl")
'-----------------------------------------------------------------------------------
' Clear the trans table
'-----------------------------------------------------------------------------------
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM TransTbl"
DoCmd.SetWarnings True
ITNO = 1
While Not EOF(ITNO)
TNO = 1
TACT = 2
TABLE = inputCSV
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'read input line
If InStr(TLINE, """") < 1 Then
If IdentifyFields(TLINE, FLD1, FLD2, FLD3, FLD4, Lim) = 2 Then
GoTo Add_Trans
End If
Else
TNO = 2
TACT = 5
TABLE = LogFile
TLINE = "FLD1=" & FLD1 & " FLD2=" & FLD2 & " FLD3=" & FLD3 & " FLD4=" & FLD4 & " is rejected"
ReadWriteTable TNO, TACT, TABLE, TLINE 'write output line
K = K + 1 'Rejected transactions
End If
GoTo End_Trans
'--------------------------------------------------------------------------------------
' Now copy the fields from transactions to TransTbl
'-------------------------------------------------------------------------------------
Add_Trans:
rstrans.AddNew
rstrans("FirstName").Value = FLD1
rstrans("LastName").Value = FLD2
rstrans("Email").Value = FLD3
rstrans("Language").Value = FLD4
rstrans("Federation").Value = ORG
rstrans.Update
J = J + 1 'Accepted transaction
End_Trans:
I = I + 1 'total transactions except header
Wend
Exit_Func:
rstrans.Close
Set rstrans = Nothing
TACT = 6
TNO = 1
TABLE = inputCSV
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'close input
TNO = 2
TABLE = LogFile
TLINE = " "
ReadWriteTable TNO, TACT, TABLE, TLINE 'close input
'---------------------------------------------------------------------------------------------------------------
' Integrity checks
'----------------------------------------------------------------------------------------------------------------
MsgBox "Transactions: Total=" & I & " Accepted=" & J & " Rejected=" & K
Exit Function
Err_Exit:
MsgBox "Error Number " & Err & " " & Err.Description
Resume Exit_Func
End Function
Function IdentifyFields(TLINE, FLD1 As String, FLD2 As String, FLD3 As String, FLD4 As String, Lim As String) As Integer
Dim L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
L1 = InStr(1, TLINE, Lim)
L2 = InStr(L1 + 1, TLINE, Lim)
L3 = InStr(L2 + 1, TLINE, Lim)
L4 = InStr(L3 + 1, TLINE, Lim)
If L4 = 0 Then L4 = Len(TLINE) + 1
If (InStr(L3 + 1, TLINE, Lim) > 0) Then L4 = InStr(L3 + 1, TLINE, Lim)
If (InStr(L3 + 1, TLINE, Chr(13)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(13))
If (InStr(L3 + 1, TLINE, Chr(10)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(10))
If (InStr(L3 + 1, TLINE, Chr(10)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(59))
FLD1 = Left(TLINE, L1 - 1)
FLD2 = Mid(TLINE, L1 + 1, L2 - L1 - 1)
FLD3 = Mid(TLINE, L2 + 1, L3 - L2 - 1)
FLD4 = Mid(TLINE, L3 + 1, L4 - L3 - 1)
Debug.Print "FLD1="; FLD1; " FLD2="; FLD2; " FLD3="; FLD3; " FLD4="; FLD4
If FLD1 = "FirstName" And FLD2 = "LastName" And FLD3 = "Email" And FLD4 = "Language" Then
IdentifyFields = 1 'header records
Debug.Print "header record FLD1="; FLD1
Else
If Not IsNull(FLD1) And Not IsNull(FLD2) And Not IsNull(FLD3) And Not IsNull(FLD4) And Len(FLD4) = 1 Then
IdentifyFields = 2 'normal record
Debug.Print "normal record FLD1="; FLD1
Else
IdentifyFields = 3 'anything else error
End If
End If
End Function
Code:
Function IdentifyFields(TLINE, FLD1 As String, FLD2 As String, FLD3 As String, FLD4 As String, Lim As String) As Integer
Dim L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
L1 = InStr(1, TLINE, Lim)
L2 = InStr(L1 + 1, TLINE, Lim)
L3 = InStr(L2 + 1, TLINE, Lim)
L4 = InStr(L3 + 1, TLINE, Lim)
If L4 = 0 Then L4 = Len(TLINE) + 1
If (InStr(L3 + 1, TLINE, Lim) > 0) Then L4 = InStr(L3 + 1, TLINE, Lim)
If (InStr(L3 + 1, TLINE, Chr(13)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(13))
If (InStr(L3 + 1, TLINE, Chr(10)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(10))
If (InStr(L3 + 1, TLINE, Chr(10)) > 0) Then L4 = InStr(L3 + 1, TLINE, Chr(59))
FLD1 = Left(TLINE, L1 - 1)
FLD2 = Mid(TLINE, L1 + 1, L2 - L1 - 1)
FLD3 = Mid(TLINE, L2 + 1, L3 - L2 - 1)
FLD4 = Mid(TLINE, L3 + 1, L4 - L3 - 1)
Debug.Print "FLD1="; FLD1; " FLD2="; FLD2; " FLD3="; FLD3; " FLD4="; FLD4
If FLD1 = "FirstName" And FLD2 = "LastName" And FLD3 = "Email" And FLD4 = "Language" Then
IdentifyFields = 1 'header records
Debug.Print "header record FLD1="; FLD1
Else
If Not IsNull(FLD1) And Not IsNull(FLD2) And Not IsNull(FLD3) And Not IsNull(FLD4) And Len(FLD4) = 1 Then
IdentifyFields = 2 'normal record
Debug.Print "normal record FLD1="; FLD1
Else
IdentifyFields = 3 'anything else error
End If
End If
End Function
Code:
'Function ReadWriteTable
'This function provides functions to handle a simple text file.
'TNO is the stream number assigned to the file.
'TACT defines the function to be executed. Table is filename.
'TLine is a line of text to be written in the file.
'For TACT = 1, 3, 4, 6, 7, 8, 9 TLine is blank.
'TACT = 1 Open Input, 2 Read Input, 3 Open Append, 4 Open/Create Output,
'5 Print Line, 6 Close, 7 View in Notepad, 8 View in Excel, 9 Delete
'For read the function value is the line of characters read from the file
'To use this script insert the following Line after the
'Option statements as a comment "'$Include: "ReadWriteTable.bas""
Public Function ReadWriteTable(TNO As Integer, TACT As Integer, _
TABLE As String, TLINE As String) As String
Dim filename As String
If (TABLE = "") Or (TNO < 1 And TNO > 256) Or (TACT < 1 And TACT > 9) Then
MsgBox "TNO=" & TNO & " TACT=" & TACT & " Table=" & TABLE & " Wrong input output parameters", , GC_Title
ReadWriteTable = "ERROR"
Exit Function
End If
filename = TABLE
Debug.Print "TNO= "; TNO; " filename= "; filename; " TACT= "; TACT
Select Case TACT
Case 1
Open filename For Input As #TNO ' Open table as text file
Case 2
If EOF(TNO) Then 'Read line by line until end of file
ReadWriteTable = "EOF"
Else
Line Input #TNO, TLINE
ReadWriteTable = TLINE
End If
Case 3
Open filename For Append As #TNO 'append a line
Case 4
Open filename For Output As #TNO 'open for output
Case 5
Debug.Print "TLine="; TLINE
Print #TNO, TLINE 'write a line
Case 6
Close #TNO
Case 7
' Open the file with notepad
Shell "notepad.exe " & filename, vbNormalFocus
Case 8
' Open the file with excel
If EOF(TNO) Then 'Read line by line until end of file
ReadWriteTable = "EOF"
Else
Line Input #TNO, TLINE
ReadWriteTable = TLINE
End If
Shell "C:\Program Files\Microsoft Office\Office10\excel.exe " _
& filename, vbNormalFocus
Case 9
' Delete file
Kill (filename)
End Select
End Function