Windward Software Wiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== 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>