Public Function GetFile() As String
' Set up the File Dialog.
Dim fdialog As FileDialog
Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
With fdialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select a file"
' Clear out the current filters, and add your own.
.Filters.Clear
.Filters.Add "Text File", "*.txt"
'.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
If fdialog.SelectedItems(1) <> vbNullString Then
GetFile = fdialog.SelectedItems(1)
End If
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Function
Public Sub ReadLineByLine(strFile As String)
' ***************************************************
' * Open a Text File And Loop Through It *
' ***************************************************
Dim intFile As Integer
Dim StrIn As String
Dim TheSegment As String
Dim ThePrintDate As String
Dim ThePage As String
Dim TheMOM_ID As String
Dim TheMOM_Txt As String
Dim TheMOM_MMC As String
Dim TheDepartment As String
Dim TheReferenceNo As String
Dim TheReferenceName As String
Dim TheS_No As String
Dim TheInstrument As String
Dim TheAmount As String
Dim TheReject As String
Dim TheWarning As String
Dim TheException As String
Dim TheError As String
Dim InstRejected As Boolean
Dim NoExceptions As Boolean
Dim TempArray() As String
Dim FirstRecord As Boolean
intFile = FreeFile()
Open strFile For Input As #intFile
Do While Not EOF(intFile)
Line Input #intFile, StrIn
If InStr(StrIn, "SEGMENT :") > 0 Then
'Debug.Print strIn
TheSegment = FindAfter(StrIn, "SEGMENT :")
'Debug.Print TheSegment
ThePrintDate = FindAfter(StrIn, "Print Date ")
'Debug.Print ThePrintDate
ThePage = FindAfter(StrIn, "Page")
'Debug.Print ThePage
'Next line is MOM ID
Line Input #intFile, StrIn
'debug.print StrIn
TheMOM_ID = FindAfter(StrIn, "MOM ID:")
TheMOM_Txt = FindAfter(StrIn, "MOM ID: " & TheMOM_ID)
' Debug.Print "Mom_ID " & TheMOM_ID
' The next line is Department Name
Line Input #intFile, StrIn
'Debug.Print strIn
TheDepartment = FindAfter(StrIn, "Department Name:")
TheMOM_MMC = FindAfter(StrIn, "Department Name: " & TheDepartment)
'Debug.Print TheDepartment
InsertSegment TheSegment, ThePrintDate, ThePage, TheMOM_ID, TheMOM_Txt, TheMOM_MMC, TheDepartment
ElseIf InStr(StrIn, "Reference:") > 0 And InStr(StrIn, "Reference Name:") > 0 Then
TheReferenceNo = FindAfter(StrIn, "Reference:")
'Debug.Print "ref No: " & TheReferenceNo
TheReferenceName = FindAfter(StrIn, "Reference Name:")
'Debug.Print "Ref Name " & TheReferenceName
End If
If InStr(StrIn, "S.No Instrument Number Amount") > 0 Then
'Move two lines down
Line Input #intFile, StrIn
FirstRecord = True
Do
Line Input #intFile, StrIn
StrIn = Trim(StrIn)
'Special code to handle the problem seen in sample error 1
If InStr(StrIn, "Zone VALIDATION RUN") > 0 Then Exit Do
If IsNumeric(Left(StrIn, 1)) Then
'If the line has an S_No but not the first record than have to do an insert query because you have come to a second line
If Not FirstRecord Then
InsertRejection TheMOM_ID, TheReferenceNo, TheReferenceName, TheS_No, TheInstrument, TheAmount, TheReject, TheWarning, TheException, TheError, InstRejected, NoExceptions
End If
'this is a line with the S_No
TempArray = GetCleanArray(StrIn)
TheS_No = TempArray(0)
'Debug.Print "S_No: " & TheS_No
TheInstrument = TempArray(1)
' Debug.Print "Instrument " & TheInstrument
TheAmount = TempArray(2)
'Debug.Print "Amount " & TheAmount
End If
FirstRecord = False
If InStr(StrIn, "Rej Reason :") > 0 Then TheReject = FindAfter(StrIn, "Rej Reason :")
'Account for multiple warnings.
If InStr(StrIn, "Warning :") > 0 Then
If TheWarning = "" Then
TheWarning = FindAfter(StrIn, "Warning :")
Else
TheWarning = TheWarning & "; " & FindAfter(StrIn, "Warning :")
End If
End If
If InStr(StrIn, "Exception :") > 0 Then TheException = FindAfter(StrIn, "Exception :")
If InStr(StrIn, "Error :") > 0 Then TheError = FindAfter(StrIn, "Error :")
If InStr(StrIn, "Instrument Rejected") > 0 Then InstRejected = True
If InStr(StrIn, "No Exception or Warnings encountered") > 0 Then NoExceptions = True
'At the end of the block have to do another insert
If Left(StrIn, 1) = "-" Then
InsertRejection TheMOM_ID, TheReferenceNo, TheReferenceName, TheS_No, TheInstrument, TheAmount, TheReject, TheWarning, TheException, TheError, InstRejected, NoExceptions
Exit Do
End If
Loop
End If
Loop
Close #intFile
End Sub
Public Function FindAfter(ByVal SearchIn, SearchAfter) As String
'This will find the text after a given search for text. The text is considered as a single item if no more than one space in the text
'Do not know if this is any faster, probably not. Makes the code a little more reuseable
'SEGMENT : CLASS7 Print Date 04-07-2018 12:40:37 Page 3 of 2000
'If SearchAfter = "SEGMENT :" then it returns CLASS7, if "Print Date" it returns "04-07-2018 12:40:37", and "Page" returns "3 or 2000"
FindAfter = Trim(Split(SearchIn, SearchAfter)(1))
FindAfter = Trim(Split(FindAfter, " ")(0))
End Function
Public Function GetCleanArray(ByVal StrIn As String) As String()
Dim oldString As String
'Remove three spaces and replace with two until only 2 spaces exist, then split on two spaces
'A line like below can be put into an array of 1, 10, 2,000.00
' 1 10 2,000.00
StrIn = Trim(StrIn)
Do While StrIn <> oldString
oldString = StrIn
StrIn = Replace(StrIn, " ", " ")
Loop
GetCleanArray = Split(StrIn, " ")
End Function
Public Function SqlText(TheText As String) As String
'Prepares a string value for entry into a sql insert string
If TheText = "" Then
SqlText = "Null"
Else
TheText = Replace(Trim(TheText), "'", "''")
SqlText = "'" & TheText & "'"
End If
End Function
Public Function SQL_Date(strDate As String) As String
'Turns a dd-mm-yyyy hh:mm:ss into a mm/dd/yyyy hh:mm:ss needed for a SQL insert regardless of regional settings
'04-07-2018 becomes #07/04/2018# for the insert
Dim aDate() As String
If IsNull(strDate) Then
SQL_Date = "Null"
Else
'Debug.Print strDate
aDate = Split(strDate, "-")
SQL_Date = aDate(1) & "/" & aDate(0) & "/" & aDate(2)
If Not IsDate(SQL_Date) Then
Debug.Print "Bad Date: " & SQL_Date
SQL_Date = "Null"
Else
SQL_Date = "#" & SQL_Date & "#"
End If
End If
'Debug.Print SQL_Date
End Function
Public Function SQL_Number(varNumber As Variant) As String
If IsNumeric(varNumber) Then
varNumber = Replace(varNumber, ",", "")
SQL_Number = CStr(varNumber)
Else
SQL_Number = "NULL"
End If
End Function
Public Sub InsertSegment(TheSegment As String, ThePrintDate As String, ThePage As String, ByVal TheMOM As String, TheMOM_Txt As String, TheMOM_MMC As String, TheDepartment As String)
'Put your real table name below
On Error GoTo errlbl
Const Table1 = "Table1"
Dim strSql As String
TheSegment = SqlText(TheSegment)
ThePage = SqlText(ThePage)
ThePrintDate = SQL_Date(ThePrintDate)
TheMOM = SqlText(TheMOM)
TheMOM_Txt = SqlText(TheMOM_Txt)
TheMOM_MMC = SqlText(TheMOM_MMC)
TheDepartment = SqlText(TheDepartment)
strSql = "Insert Into " & Table1 & "(Segment, Print_Date, Page, MOM_ID, MOM_TXT, MOM_MMC, Department_Name) VALUES ( " & TheSegment & ", " & ThePrintDate & ", " & ThePage & ", " & TheMOM & ", " & TheMOM_Txt & ", " & TheMOM_MMC & ", " & TheDepartment & ")"
'Debug.Print strSql
CurrentDb.Execute strSql
Exit Sub
errlbl:
Debug.Print Err.Number & " " & Err.Description & " " & vbCrLf & strSql
Resume Next
End Sub
Public Sub InsertRejection(ByVal TheMomID As String, ByVal TheReferenceNo As String, ByVal TheReferenceName As String, TheS_No As String, TheInstrument As String, TheAmount As String, TheReject As String, TheWarning As String, TheException As String, TheError As String, InstRejected As Boolean, NoExceptions As Boolean)
'Put your real table name below
On Error GoTo errlbl
Const Table1 = "Table2"
Dim strSql As String
TheReject = SqlText(TheReject)
TheWarning = SqlText(TheWarning)
TheException = SqlText(TheException)
TheError = SqlText(TheError)
TheReferenceNo = SqlText(TheReferenceNo)
TheMomID = SqlText(TheMomID)
TheAmount = SQL_Number(TheAmount)
TheS_No = SQL_Number(TheS_No)
TheInstrument = SQL_Number(TheInstrument)
TheReferenceName = SqlText(TheReferenceName)
strSql = "Insert Into " & Table1 & "(MOM_ID_FK, Reference_No, Reference_Name,S_No,Instrument_Number,Amount,Reject_Reason, Warning,Exception, Error_Msg, Instrument_rejected, No_Exc_No_Warn) VALUES ( " & TheMomID & ", " & TheReferenceNo & ", " & TheReferenceName & ", " & TheS_No & ", " & TheInstrument & ", " & TheAmount & ", " & TheReject & ", " & TheWarning & ", " & TheException & ", " & TheError & ", " & InstRejected & ", " & NoExceptions & ")"
'Debug.Print strSql
CurrentDb.Execute strSql
TheS_No = ""
TheInstrument = ""
TheAmount = ""
TheReject = ""
TheWarning = ""
TheException = ""
TheError = ""
InstRejected = False
NoExceptions = False
Exit Sub
errlbl:
Debug.Print Err.Number & " " & Err.Description & " " & vbCrLf & strSql
Resume Next
End Sub