Option Explicit

Dim source_path As String

''this function will fetch all csv files stored inside the directory specified in csv_path variable ''as a parameter and add them in a listbox
Public Function GetCSVFiles(ByVal csv_path As String) As Boolean
Dim FileName As String, ext As String, pos As Integer, i As Integer

On Error GoTo load_error

If Right(csv_path, 1) <> "\" Then
    csv_path = csv_path & "\"
Else
    csv_path = csv_path
End If

If Dir(Trim(csv_path)) = "" Then
    GetCSVFiles = False
    Exit Function
End If

source_path = csv_path
FileName = csv_path & "*.*"

Do Until FileName = ""
    For i = Len(FileName) To 1 Step -1
        pos = InStr(i, FileName, ".")
        If pos > 0 Then Exit For
    Next i
    ext = LCase(Mid(FileName, pos + 1))
    If ext = "csv" Then
        List1.AddItem FileName
    End If
    FileName = Dir()
    Randomize
    If FileName = "" Then
        Exit Do
    End If
Loop

GetCSVFiles = True

Exit Function

load_error:
    Err.Clear
    GetCSVFiles = False
    Exit Function
End Function

''this routine will do the actual job. it will read csv file one by one from the listbox and then ''parse it data to create a separate text file.
Private Sub Command1_Click()
Dim i As Integer, fso As New FileSystemObject

If GetCSVFiles(Trim(Text1.Text)) = False Then
    MsgBox "File extraction error."
    Exit Sub
End If

On Error GoTo err1

If List1.ListCount > 0 Then
    If fso.FolderExists(source_path & "Data\") = False Then
        fso.CreateFolder (source_path & "Data")
    End If
    For i = 0 To List1.ListCount - 1 Step 1
        Call CreateTextFromCSV(source_path & List1.List(i))
    Next i
    MsgBox "Extraction complete."
End If

Exit Sub

err1:
    Err.Clear
    MsgBox "Some files could not be generated."
    Exit Sub
End Sub

''this routine will be called from command1_click() event to create the text file with parsed ''data from the csv file. the path to the csv file will be passed as parameter in the ''csv_filename variable.
Public Sub CreateTextFromCSV(ByVal csv_filename As String)
Dim fso, act
Dim total_imported_text As String, total_split_text() As String, myData As String, comma_split() As String
Dim dt1 As Date, dt2 As Date, Fileld2OfExcel As String, myData1 As String, txt() As String
Dim total_num_imported As Double, i As Integer
Dim L_B_Found As Boolean, Less_D_Found As Boolean
                
Set fso = CreateObject("scripting.filesystemobject")
Set act = fso.OpenTextFile(csv_filename)

total_imported_text = act.ReadAll
total_imported_text = Replace(total_imported_text, Chr(13), "*")
total_imported_text = Replace(total_imported_text, Chr(10), "*")
total_imported_text = Replace(total_imported_text, Chr(34), "")
total_split_text = Split(total_imported_text, "*")
total_num_imported = UBound(total_split_text)
For i = 1 To total_num_imported - 1
    comma_split = Split(total_split_text(i), ",")
    On Error Resume Next
    If comma_split(0) <> "" Then
        Fileld2OfExcel = Trim(Mid(comma_split(0), 2))
        If Fileld2OfExcel <> "" Then
            If Dir(source_path & "Data\" & comma_split(0) & ".txt") = "" Then
                Open source_path & "Data\" & comma_split(0) & ".txt" For Output As #1
                    Print #1, Format$(comma_split(10), "dd/mm/yyyy") & "," & comma_split(2) & "," & _
                        comma_split(3) & "," & comma_split(4) & "," & comma_split(5) & "," & comma_split(8)
                Close #1
        Else
            L_B_Found = False
            Less_D_Found = False
            myData = ""
            myData1 = ""
            Open source_path & "Data\" & comma_split(0) & ".txt" For Input As #1
                Do While Not EOF(1)
                    Line Input #1, myData
                    If myData <> "" Then
                       txt = Split(myData, ",")
                       dt1 = CDate(comma_split(10))
                       dt2 = CDate(Format(txt(0), "dd/mm/yyyy"))
                       If dt1 = dt2 Then
                          L_B_Found = True
                          myData1 = myData1 & myData & vbCrLf
                       ElseIf dt1 < dt2 Then
                          If Less_D_Found = False Then
                             Less_D_Found = True
                             myData1 = myData1 & Format$(comma_split(10), "dd/mm/yyyy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) & "," & comma_split(5) & "," & comma_split(8) & vbCrLf & myData & vbCrLf
                          Else
                          L_B_Found = False
                             myData1 = myData1 & myData & vbCrLf
                          End If
                       Else
                          myData1 = myData1 & myData & vbCrLf & Format$(comma_split(10), "dd/mm/yyyy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) & "," & comma_split(5) & "," & comma_split(8) & vbCrLf
                       End If
                    End If
                Loop
                Close #1
                If L_B_Found = False Then
                    Open source_path & "Data\" & comma_split(0) & ".txt" For Output As #1
                         Print #1, myData1
                    Close #1
              End If
           End If
        End If
     End If
Next i
End Sub