Private Function CheckFilesForCorruption(r As DAO.Recordset, _
sInputDirectory As String) As Boolean
Dim sProgressBarIncrement As Single
Dim ReadFileHandle As Integer
Dim sTableOut As String
Dim sFileName As String
Dim sInputLine As String
Dim sFieldsPerSchema() As String
Dim sFieldsImported() As String
Dim iFieldSizesPerSchema() As Integer
Dim iSemiColonCount As Integer
Dim lLineCounter As Long
Dim iFieldCounter As Integer
If PRODUCTION_RELEASE Then On Error GoTo ErrorHandler
CheckSpoolFilesForCorruption = True
sProgressBarIncrement = 100# / r.RecordCount 'Calculate how many steps we have
UpdateProgressBar Me, pbarStepProgress, 0
lblCurrentStep.Caption = PROCESS_MSG_CHECK_CORRUPTION
With r
.MoveFirst
Do While Not .EOF
'Setup variables and update the GUI.
sTableOut = !Table_Names
sFileName = !Import_File_Name
ReDim sFieldsPerSchema(0)
ReDim iFieldSizesPerSchema(0)
UpdateProgressBar Me, pbarStepProgress, _
pbarStepProgress.Value + sProgressBarIncrement
'First parse the schema.ini to find out what the file should look like
ReadFileHandle = FreeFile
Open sInputDirectory & "schema.ini" For Input As #ReadFileHandle
Do While Not EOF(ReadFileHandle)
'Search the schema.ini for the field definitions
Line Input #ReadFileHandle, sInputLine
'Find the entry for the file
If Mid(sInputLine, 1, Len(sFileName) + 2) = _
"[" & sFileName & "]" Then
'Read in the field information
Do While Not EOF(ReadFileHandle) And sInputLine <> ""
Line Input #ReadFileHandle, sInputLine
If Left(sInputLine, 4) Like "Col#" Then
ReDim Preserve sFieldsPerSchema(UBound(sFieldsPerSchema) + 1)
ReDim Preserve iFieldSizesPerSchema(UBound(sFieldsPerSchema) + 1)
'Set the Upper element 1st part on the sFieldsPerSchema array to be the column
'name per the Schema.ini file.
sFieldsPerSchema(UBound(sFieldsPerSchema) - 1) = _
Mid(sInputLine, _
InStr(1, sInputLine, "=") + 1, _
InStr(1, sInputLine, " ") - InStr(1, sInputLine, "=") - 1)
'Set the Upper element 2nd part on the sFieldsPerSchema array to be the text width
'if applicable per the Schema.ini file.
If Right(sInputLine, 2) Like "##" Then
iFieldSizesPerSchema(UBound(sFieldsPerSchema) - 1) = _
CInt(Mid(sInputLine, InStrRev(sInputLine, " ")))
End If
End If
Loop
ReDim Preserve sFieldsPerSchema(UBound(sFieldsPerSchema) - 1)
ReDim Preserve iFieldSizesPerSchema(UBound(iFieldSizesPerSchema) - 1)
GoTo CloseSchemeIni
End If
Loop
CloseSchemeIni:
Close #ReadFileHandle
'We are done with the Schema.ini file. We should have, after all that, a sFieldsPerSchema
'array containing all the column names per the Schema.ini file.
'Now open up the Spool file.
'We want to check
' 1) Are the column headings the same (for text description, and in number)
' 2) For each data row, are there enough fields per line
' 3) Are the fields in the row greater than 255 characters
' 4) Are there blank lines in the file?
' 5) Are there " marks in the file
ReadFileHandle = FreeFile
Open sInputDirectory & sFileName For Input As #ReadFileHandle
If LOF(ReadFileHandle) = 0 Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
True, _
ERROR_MSG_CORRUPTION_FILE_EMPTY)
GoTo TryNextFile
End If
'Check the headings line
Line Input #ReadFileHandle, sInputLine
lLineCounter = 1
sFieldsImported = Split(sInputLine, ";")
iSemiColonCount = UBound(sFieldsImported)
' 1) Check there is the same number
If UBound(sFieldsImported) <> UBound(sFieldsPerSchema) Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
True, _
ERROR_MSG_CORRUPTION_FIELD_COUNT_UNEQUAL)
CheckSpoolFilesForCorruption = False
GoTo TryNextFile
Else
'If there is the same number, check they have the same names
For iFieldCounter = 0 To UBound(sFieldsPerSchema)
If sFieldsImported(iFieldCounter) <> sFieldsPerSchema(iFieldCounter) Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
False, _
ERROR_CORRUPTION_MSG_FIELD_NAMES_UNEQUAL)
End If
Next iFieldCounter
End If
TryNextLine:
Do While Not EOF(ReadFileHandle)
Line Input #ReadFileHandle, sInputLine
lLineCounter = lLineCounter + 1
'Note, the header line has no trailing ; but data lines do. Hence, we sort this out below.
sFieldsImported = Split(sInputLine, ";")
'Update the screen every 1000 lines
If lLineCounter Mod 1000 = 0 Then
lblCurrentStep.Caption = PROCESS_MSG_CHECK_CORRUPTION & sTableOut & _
" Line: " & Format(lLineCounter, "#,###")
Me.Repaint
End If
'Check blank lines
If sInputLine = "" Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
False, _
ERROR_MSG_CORRUPTION_BLANK_LINE)
GoTo TryNextLine
End If
'Check data field count
If iSemiColonCount <> Maximum(UBound(sFieldsImported) - 1, 0) Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
True, _
ERROR_MSG_CORRUPTION_MALFORMED_DATA_LINE)
GoTo TryNextLine
End If
'Check each data item:
For iFieldCounter = 0 To UBound(sFieldsImported)
'For length ...
If iFieldSizesPerSchema(iFieldCounter) > 0 And _
Len(sFieldsImported(iFieldCounter)) > iFieldSizesPerSchema(iFieldCounter) Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
False, _
ERROR_CORRUPTION_MSG_FIELD_TOO_LONG)
End If
'... and illegal characters
If InStr(1, sFieldsImported(iFieldCounter), QUOTE_MARK) <> 0 Then
CurrentDb.Execute SQL_APPEND_TO_ERROR_TABLE(sTableOut, _
sFileName, _
lLineCounter, _
True, _
ERROR_CORRUPTION_MSG_FIELD_CONTAINS_QUOTE_MARK)
End If
Next iFieldCounter
Loop
TryNextFile:
Close #ReadFileHandle
.MoveNext
Loop
End With
Exit Function
ErrorHandler:
MsgBox ERROR_MSG_CHECK_FILES_FOR_CORRUPTION & Err.Description
End Function
