System Five Add-Ons & Integrations help simplify the way you do things.
Our catalog of services has topic-based, role-based, or technical plans that can help you maximize your software investment.
Copyright © 1984-present
Windward Software Systems Inc.
All Rights Reserved.
Privacy Policy
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.
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
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
' 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. '
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