User Tools

Site Tools


converting_ascii_reports_to_flat_files

Converting ASCII reports to flat files

The basic idea behind this routine is to take a report that was printed to file, and convert it to a flat file. These files are often multi line fixed width files. It gets complex if you have to add logic for special scenarios, so unless you really know what you are doing I suggest that you do the last bit of cleanup yourself.

Modules and Classes from the Excel Code (Advanced Macro Stuff)

modProcessRecord

Sub MainProcess()
 
    LoopRecords "Cust_NoHeader"
    LoopRecords "Ven_NoHeader"
    LoopRecords "Month_NoHeader_NoHeader_NoHeader"
 
    MsgBox "Done"
 
End Sub
 
 
Sub LoopRecords(strFilePrefix As String)
' Purpose: To loop through the multi line records. Make sure we clearly idenfity the condition for detecting the Header Start
 
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
 
    Dim streamIn As Scripting.TextStream
    Dim streamOutFlat As Scripting.TextStream
 
    Set streamIn = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & ".TXT", ForReading, False)
    Set streamOutFlat = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & "_Flat.csv", ForWriting, True)
 
    If strFilePrefix = "Cust_NoHeader" Then
        WriteCustHeader streamOutFlat
    ElseIf strFilePrefix = "Ven_NoHeader" Then
        WriteVendHeader streamOutFlat
    ElseIf strFilePrefix = "Month_NoHeader_NoHeader_NoHeader" Then
        WriteInventoryHeader streamOutFlat
    Else
        WriteCustHeader streamOutFlat
    End If
 
    Dim strTemp As String
 
    Dim Read_LineNumber
    Read_LineNumber = 0
 
 
    Dim RecordLineNum
    RecordLineNum = 0
    Dim arrStrRecord
    ReDim arrStrRecord(1)
 
    strTemp = streamIn.ReadLine
 
    Do While Not streamIn.AtEndOfStream
        Read_LineNumber = Read_LineNumber + 1
        RecordLineNum = RecordLineNum + 1
        If Trim(Left(strTemp, 2)) <> "" Then          ' This is the start of a new record
            If Read_LineNumber > 1 Then
                If strFilePrefix = "Cust_NoHeader" Then
                    streamOutFlat.WriteLine ProcessRecord_Cust(arrStrRecord)
                ElseIf strFilePrefix = "Ven_NoHeader" Then
                    streamOutFlat.WriteLine ProcessRecord_Cust(arrStrRecord)
                ElseIf strFilePrefix = "Month_NoHeader_NoHeader_NoHeader" Then
                    streamOutFlat.WriteLine ProcessRecord_Inventory(arrStrRecord)
                Else
                    streamOutFlat.WriteLine ProcessRecord_Cust(arrStrRecord)
                End If
            End If
            RecordLineNum = 1
            ReDim arrStrRecord(RecordLineNum)
            arrStrRecord(RecordLineNum) = strTemp
        Else
            ReDim Preserve arrStrRecord(RecordLineNum)
            arrStrRecord(RecordLineNum) = strTemp
        End If
        strTemp = streamIn.ReadLine
    Loop
 
End Sub
 
 
Function ProcessRecord_Inventory(ByRef arrStrRecord) As String
 
    Dim i
    Dim Inv As udtInventory
    Set Inv = New udtInventory
 
    Dim strTemp
    strTemp = ""
    For i = 1 To UBound(arrStrRecord)
        strTemp = arrStrRecord(i)
        If i = 1 Then
            Inv.PartNumber = Trim(Left(strTemp, 4))
            Inv.Desc = Trim(Mid(strTemp, 5))
        ElseIf i = 2 Then
            Inv.Price = Trim(strTemp)
        End If
    Next i
 
    strTemp = ""
    strTemp = strTemp & """" & Inv.PartNumber & """"
    strTemp = strTemp & "," & """" & Inv.Desc & """"
    strTemp = strTemp & "," & """" & Inv.Price & """"
    strTemp = strTemp & "," & """" & Inv.MainCat & """"
    strTemp = strTemp & "," & """" & Inv.SubCat & """"
 
    ProcessRecord_Inventory = strTemp
 
'1234567980123456798012345679801234567980123456798012345679801234567980123456798012345679801234567980
'11C CHANDLIERS / CRYSTAL / CRYSTAL CLEANER
'                                                   461.85
'
 
 
End Function
 
 
Function ProcessRecord_Cust(ByRef arrStrRecord) As String       ' Same format for vendor file
 
    Dim i
    Dim cust As udtCustomer
    Set cust = New udtCustomer
 
    Dim strTemp
    strTemp = ""
    For i = 1 To UBound(arrStrRecord)
        strTemp = arrStrRecord(i)
        If i = 1 Then
            cust.CustomerNumber = Trim(Left(strTemp, 11))
            cust.CompanyName = Trim(Mid(strTemp, 12, 31))
            cust.Phone = Trim(Mid(strTemp, 44, 15))
            cust.Fax = Trim(Mid(strTemp, 59, 13))
        ElseIf i = 2 Then
            cust.AddressLine1 = Trim(Mid(strTemp, 12, 30))
        ElseIf i = 3 Then
            cust.AddressLine2 = Trim(Mid(strTemp, 12, 30))
            cust.Terms = Trim(Mid(strTemp, 52, 9))
            cust.OtherField = Trim(Mid(strTemp, 67, 10))
        ElseIf i = 4 Then
            cust.AddressLine3 = Trim(Mid(strTemp, 12, 30))
        ElseIf i = 5 Then
            cust.BlankLine = Trim(strTemp)
        End If
    Next i
 
    strTemp = ""
    strTemp = strTemp & """" & cust.CustomerNumber & """"
    strTemp = strTemp & "," & """" & cust.CompanyName & """"
    strTemp = strTemp & "," & """" & cust.AddressLine1 & """"
    strTemp = strTemp & "," & """" & cust.AddressLine2 & """"
    strTemp = strTemp & "," & """" & cust.AddressLine3 & """"
    strTemp = strTemp & "," & """" & cust.Phone & """"
    strTemp = strTemp & "," & """" & cust.Fax & """"
    strTemp = strTemp & "," & """" & cust.Terms & """"
    strTemp = strTemp & "," & """" & cust.OtherField & """"
    strTemp = strTemp & "," & """" & cust.BlankLine & """"
 
    ProcessRecord_Cust = strTemp
 
'1234567980123456798012345679801234567980123456798012345679801234567980123456798012345679801234567980
'49B215100  49 BSB ENTERPRISES LLC            327-6300      327-6301
'           P O BOX 384120
'           WAIKOLOA, HI  96738                     NET 5          Y 4
'           CONT.
'
 
End Function
 
 
Sub WriteInventoryHeader(streamOut As Scripting.TextStream)
    Dim strTemp
    strTemp = ""
 
' PartNumber
' Desc
' Price
' MainCat
' SubCat
 
    strTemp = strTemp & "PartNumber"
    strTemp = strTemp & "," & "Desc"
    strTemp = strTemp & "," & "Price"
    strTemp = strTemp & "," & "MainCat"
    strTemp = strTemp & "," & "SubCat"
 
    streamOut.WriteLine strTemp
 
End Sub
 
 
Sub WriteCustHeader(streamOut As Scripting.TextStream)
    Dim strTemp
    strTemp = ""
 
' Customer ID
' Customer Name
' Address line1
' Address line2
' Address line3
' Phone
' Fax
' Terms
' FC_PLVL
 
    strTemp = strTemp & "CustomerID"
    strTemp = strTemp & "," & "CustomerName"
    strTemp = strTemp & "," & "AddressLine1"
    strTemp = strTemp & "," & "AddressLine2"
    strTemp = strTemp & "," & "AddressLine3"
    strTemp = strTemp & "," & "Phone"
    strTemp = strTemp & "," & "Fax"
 
    strTemp = strTemp & "," & "Terms"
    strTemp = strTemp & "," & "FC_PLVL"
    strTemp = strTemp & "," & "BlankLine"
 
    streamOut.WriteLine strTemp
 
End Sub
 
 
Sub WriteVendHeader(streamOut As Scripting.TextStream)
    Dim strTemp
    strTemp = ""
 
' Vendor ID
' Vendor Name
' Address line1
' Address line2
' Address line3
' Phone
' Fax
' Terms
' FC_PLVL
 
    strTemp = strTemp & "VendorID"
    strTemp = strTemp & "," & "VendorName"
    strTemp = strTemp & "," & "AddressLine1"
    strTemp = strTemp & "," & "AddressLine2"
    strTemp = strTemp & "," & "AddressLine3"
    strTemp = strTemp & "," & "Phone"
    strTemp = strTemp & "," & "Fax"
 
    strTemp = strTemp & "," & "Terms"
    strTemp = strTemp & "," & "FC_PLVL"
    strTemp = strTemp & "," & "BlankLine"
 
    streamOut.WriteLine strTemp
 
End Sub

modRemoveHeader

Sub Main()
 
    RemoveHeader True, "PAGE ", "-----", "Cust"
    RemoveHeader False, "PAGE ", "-----", "Cust"
 
    RemoveHeader True, "PAGE ", "-----", "Ven"
    RemoveHeader False, "PAGE ", "-----", "Ven"
 
    RemoveHeader True, "PAGE ", "-----", "Month"
    RemoveHeader False, "PAGE ", "-----", "Month"
 
    RemoveHeader True, "**", "", "Month_NoHeader"
    RemoveHeader False, "**", "", "Month_NoHeader"
 
    RemoveHeader True, "*", "", "Month_NoHeader_NoHeader"
    RemoveHeader False, "*", "", "Month_NoHeader_NoHeader"
 
    MsgBox "Done."
 
End Sub
 
 
Sub RemoveHeader(bDebugMode As Boolean, strFindHeaderStart As String, strFindHeaderEnd As String, strFilePrefix As String)
' Purpose: To remove the headers of an import file based on
 
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
 
    Dim streamIn As Scripting.TextStream
    Dim streamOutCust As Scripting.TextStream
    Dim streamOutCustLinesTrashed As Scripting.TextStream
 
    Set streamIn = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & ".TXT", ForReading, False)
    Set streamOutCustLinesTrashed = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & "_LinesTrashed.TXT", ForWriting, True)
 
    If bDebugMode Then
        Set streamOutCust = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & "_NoHeader_Debug.TXT", ForWriting, True)
    Else
        Set streamOutCust = fso.OpenTextFile("M:\Docs\_WindwardCustomers\KonaCoastHouseOfLights\" & strFilePrefix & "_NoHeader.TXT", ForWriting, True)
    End If
 
    Dim strTemp As String
 
    Dim Read_LineNumber
    Read_LineNumber = 0
 
    Dim bPageHeaderStarted As Boolean
    Dim bPageHeaderEnded As Boolean
    bPageHeaderStarted = False
    bPageHeaderEnded = True
 
    strTemp = streamIn.ReadLine
    Do While Not streamIn.AtEndOfStream
        If bPageHeaderEnded Then
            If InStr(1, strTemp, strFindHeaderStart) > 0 Then       ' Is this the start of the next header
'                Debug.Print "New record on Read_LineNumber: " & Read_LineNumber
                bPageHeaderStarted = True
                bPageHeaderEnded = False
                streamOutCustLinesTrashed.WriteLine "Read_Line(" & Read_LineNumber & "): " & strTemp
            Else
                If bDebugMode Then
                    streamOutCust.WriteLine "Read_Line(" & Read_LineNumber & "): " & strTemp
                Else
                    streamOutCust.WriteLine strTemp
                End If
            End If
        Else
            If Trim(strTemp) = "" And strFindHeaderEnd = "" Then    ' Added for Inventory file named "month"
                bPageHeaderEnded = True
                bPageHeaderStarted = False
            End If
            If InStr(1, strTemp, strFindHeaderEnd) > 0 Then         ' Is this the end of the header
                bPageHeaderEnded = True
                bPageHeaderStarted = False
            End If
            streamOutCustLinesTrashed.WriteLine "Read_Line(" & Read_LineNumber & "): " & strTemp
        End If
        strTemp = streamIn.ReadLine
        Read_LineNumber = Read_LineNumber + 1
    Loop
 
End Sub

udtCustomer

' Same format for Vendor file, so we used this UDT for the vendors as well
 
Public CustomerNumber As String
Public CompanyName As String
Public Phone As String
Public Fax As String
Public AddressLine1 As String
Public AddressLine2 As String
Public AddressLine3 As String
Public Terms As String
Public OtherField As String
Public BlankLine As String
 
'1234567980123456798012345679801234567980123456798012345679801234567980123456798012345679801234567980
'49B215100  49 BSB ENTERPRISES LLC            327-6300      327-6301
'           P O BOX 384120
'           WAIKOLOA, HI  96738                     NET 5          Y 4
'           CONT.
'

udtInventory

Public PartNumber As String
Public Price As String
 
Dim mMainCat As String
Dim mSubCat As String
Dim mDesc As String
 
 
Public Property Get MainCat() As String
    MainCat = mMainCat
End Property
 
Public Property Get SubCat() As String
    SubCat = mSubCat
End Property
 
Public Property Get Desc() As String
    Desc = mDesc
End Property
 
Public Property Let Desc(ByVal vNewValue As String)
    mDesc = vNewValue
 
    Dim slash1
    Dim slash2
    slash1 = InStr(1, mDesc, "/", vbTextCompare)
 
    If slash1 > 0 Then
        mMainCat = Trim(Left(mDesc, slash1 - 1))
        slash2 = InStr(slash1 + 1, mDesc, "/", vbTextCompare)
 
        If slash2 > 0 Then
            mSubCat = Trim(Mid(mDesc, slash1 + 1, slash2 - slash1 - 1))
        Else
            mSubCat = Trim(Mid(mDesc, slash1 + 1))
        End If
    Else
        mMainCat = "999"
        mSubCat = "999"
    End If
End Property
 
'1234567980123456798012345679801234567980123456798012345679801234567980123456798012345679801234567980
'11C CHANDLIERS / CRYSTAL / CRYSTAL CLEANER
'                                                   461.85
'
 
 
' First 4 characters are the part number
' Up to the first slash is category Level 1
' up to the second slash is category Level 2
' After the second slash is the description, but we will put the whole Less than 80 character description in.
' Second line contains a price, trim the line for price without spaces
converting_ascii_reports_to_flat_files.txt · Last modified: 2008/04/21 09:59 by cliff