User Tools

Site Tools


converting_ascii_reports_to_flat_files
no way to compare when less than two revisions

Differences

This shows you the differences between two versions of the page.


converting_ascii_reports_to_flat_files [2008/04/21 09:59 (16 years ago)] (current) – created cliff
Line 1: Line 1:
 +====== 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 ====
 +<code|x>
 +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
 +
 +
 +</code>
 +
 +==== modRemoveHeader ====
 +
 +<code|x>
 +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
 +
 +
 +</code>
 +
 +==== udtCustomer====
 +
 +<code|x>
 +' 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.
 +'
 +</code>
 +
 +==== udtInventory ====
 +
 +<code|x>
 +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
 +
 +
 +</code>
converting_ascii_reports_to_flat_files.txt · Last modified: 2008/04/21 09:59 (16 years ago) by cliff