1

I created this code so far and this is only for defined number of rows because we set counter for every header column.What happen if new batch of file coming with new number of rows ? How to start create this code?

Dim objFSO
Dim TextFile
Dim TextRead
Dim Line, Line1, Line2, Line3
Dim Count

'Open the spreadsheet using the excel application object
ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx"

Set objExcel = CreateObject("Excel.Application")'Creating excel object
Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object 
Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object)

'open the text file
Const ForReading = 1 'Constant declared so that can be used throughout the script

'Name of the text file that need to be convert
TextFile = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\HRILOANDIC20170601.txt"

'Create File system object
set objFSO = CreateObject("Scripting.FileSystemObject")

'set the text file to read and open it in read-only mode
set TextRead = objFSO.OpenTextFile(TextFile,ForReading)

CountHeader = 2 'to set row number for Excel paste
CountDetail = 4
CountTrailer = 28

SheetObject.Columns(1).NumberFormat = "@"
SheetObject.Columns(2).NumberFormat = "@"
SheetObject.Columns(3).NumberFormat = "@"
SheetObject.Columns(4).NumberFormat = "@"
SheetObject.Columns(5).NumberFormat = "@"
SheetObject.Columns(6).NumberFormat = "@"
SheetObject.Columns(7).NumberFormat = "@"
SheetObject.Columns(8).NumberFormat = "@"
SheetObject.Columns(9).NumberFormat = "@"
SheetObject.Columns(10).NumberFormat = "@"
SheetObject.Columns(11).NumberFormat = "@"
SheetObject.Columns(12).NumberFormat = "@"
SheetObject.Columns(13).NumberFormat = "@"
SheetObject.Columns(14).NumberFormat = "@"
SheetObject.Columns(15).NumberFormat = "@"

SheetObject.Cells(1, 1).Value = "Record Type"
SheetObject.Cells(1, 2).Value = "Sequence No"
SheetObject.Cells(1, 3).Value = "Contract No"
SheetObject.Cells(1, 4).Value = "Creation By"
SheetObject.Cells(1, 5).Value = "Transaction Date"
SheetObject.Cells(1, 6).Value = "Total Record"
SheetObject.Cells(1, 7).Value = "Total Amount"
SheetObject.Cells(1, 8).Value = "Source"
SheetObject.Cells(1, 9).Value = "Filler"

SheetObject.Cells(3, 1).Value = "Record Type"
SheetObject.Cells(3, 2).Value = "Sequence No"
SheetObject.Cells(3, 3).Value = "Contract No"
SheetObject.Cells(3, 4).Value = "Payment Type"
SheetObject.Cells(3, 5).Value = "Settlement Type"
SheetObject.Cells(3, 6).Value = "Effective Date"
SheetObject.Cells(3, 7).Value = "Credit Account No."
SheetObject.Cells(3, 8).Value = "Cr. Transaction Amount"
SheetObject.Cells(3, 9).Value = "Loan Type"
SheetObject.Cells(3, 10).Value = "Bank Employee ID"
SheetObject.Cells(3, 11).Value = "ID Number"
SheetObject.Cells(3, 12).Value = "ID Type Code"
SheetObject.Cells(3, 13).Value = "Bank Employee Name"
SheetObject.Cells(3, 14).Value = "HRIS Process Status"
SheetObject.Cells(3, 15).Value = "Total Record"
SheetObject.Cells(3, 16).Value = "CIF Number"
SheetObject.Cells(3, 17).Value = "Account Branch"

SheetObject.Cells(27, 1).Value = "Record Type"
SheetObject.Cells(27, 2).Value = "Sequence No"
SheetObject.Cells(27, 3).Value = "Contract No"
SheetObject.Cells(27, 4).Value = "Total Record"
SheetObject.Cells(27, 5).Value = "Total Amount"
SheetObject.Cells(27, 6).Value = "Filler"

Do Until TextRead.AtEndOfStream

    Line = TextRead.ReadLine

    If Left(Line, 1) = "H" Then

        SheetObject.Cells(CountHeader, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(CountHeader, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(CountHeader, 3).Value = Mid(Line, 11, 19) 
        SheetObject.Cells(CountHeader, 4).Value = Mid(Line, 30, 1)
        SheetObject.Cells(CountHeader, 5).Value = Mid(Line, 31, 8)
        SheetObject.Cells(CountHeader, 6).Value = Mid(Line, 39, 9)
        SheetObject.Cells(CountHeader, 7).Value = Mid(Line, 48, 17) 
        SheetObject.Cells(CountHeader, 8).Value = Mid(Line, 65, 2)
        SheetObject.Cells(CountHeader, 9).Value = Mid(Line, 67, 334)
        CountHeader = CountHeader + 1

    ElseIf Left(Line, 1) = "D" Then
        SheetObject.Cells(CountDetail, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
        SheetObject.Cells(CountDetail, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
        SheetObject.Cells(CountDetail, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C
        SheetObject.Cells(CountDetail, 4).Value = Mid(Line, 30, 10) 
        SheetObject.Cells(CountDetail, 5).Value = Mid(Line, 40, 1)
        SheetObject.Cells(CountDetail, 6).Value = Mid(Line, 41, 8)      
        SheetObject.Cells(CountDetail, 7).Value = Mid(Line, 49, 19) 
        SheetObject.Cells(CountDetail, 8).Value = Mid(Line, 68, 1)
        SheetObject.Cells(CountDetail, 9).Value = Mid(Line, 69, 17) 
        SheetObject.Cells(CountDetail, 10).Value = Mid(Line, 86, 10) 
        SheetObject.Cells(CountDetail, 11).Value = Mid(Line, 96, 40) 
        SheetObject.Cells(CountDetail, 12).Value = Mid(Line, 136, 40) 
        SheetObject.Cells(CountDetail, 13).Value = Mid(Line, 176, 3)
        SheetObject.Cells(CountDetail, 14).Value = Mid(Line, 179, 200) 
        SheetObject.Cells(CountDetail, 15).Value = Mid(Line, 379, 1)
        SheetObject.Cells(CountDetail, 16).Value = Mid(Line, 380, 19)
        SheetObject.Cells(CountDetail, 17).Value = Mid(Line, 399, 5)
        CountDetail = CountDetail + 1

    ElseIf Left(Line, 1) = "T" Then
        SheetObject.Cells(CountTrailer, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(CountTrailer, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(CountTrailer, 3).Value = Mid(Line, 30, 9)
        SheetObject.Cells(CountTrailer, 4).Value = Mid(Line, 39, 17) 
        SheetObject.Cells(CountTrailer, 5).Value = Mid(Line, 65, 2)
        SheetObject.Cells(CountTrailer, 6).Value = Mid(Line, 56, 354)
        CountTrailer = CountTrailer + 1
    Else
    'Error Handling..
    End If

     'to move down the Excel row to paste for each line in the text fix
Loop

'Save and quit
objWB.Save
objWB.Close
objExcel.Quit

Raw Data Example

Improve this question
10
  • Use a while(...) { ... } loop? Commented Dec 8, 2015 at 18:27
  • 2
    FYI I'm pretty sure you can combine all these lines into one line: SheetObject.Range(Columns(1),Columns(15)).NumberFormat = "@" Commented Dec 8, 2015 at 18:34
  • @Draco18s - Do While(...) Loop will work if the lines are always in order, meaning first 2 (or 3 or 4 or n) lines are always H, next x lines are always D and following lines are T ... If not, OP will have to get the line counts of each letter first, and use that to set the CountHeader, CountDetail, CountTrailer variables. Commented Dec 8, 2015 at 18:42
  • Ahh, yes, that would be a problem. He's going to need some kind of delimiter that tells the program that it needs to change from one case to another. Commented Dec 8, 2015 at 18:46
  • 1
    @BruceWayne and OP - Headers can also be set like this for example, to shorten code: SheetObject(Range(Cells(27,1),Cells(27,6)).Value = Array("Record Type","Sequence No","Contract No","Total Record","Total AMount","Filler") Commented Dec 8, 2015 at 19:00

1 Answer 1

Reset to default
1

Since your data always comes in the same pattern of all H lines coming first, then D lines, then T lines, you can just use one variable to count the rows and then check the first time a D or T row comes to add the headers. I made a pseudo-Boolean variable to determine when to add headers for D and T. H headers are constant at row 1.

Fully Tested Code:

Dim objFSO
Dim TextFile
Dim TextRead
Dim Line, Line1, Line2, Line3
Dim Count

'Open the spreadsheet using the excel application object
ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx"

Set objExcel = CreateObject("Excel.Application")'Creating excel object
objExcel.visible = true
Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object 
Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object)

'open the text file
Const ForReading = 1 'Constant declared so that can be used throughout the script

'Name of the text file that need to be convert
TextFile = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\HRILOANDIC20170601.txt"

'Create File system object
set objFSO = CreateObject("Scripting.FileSystemObject")

'set the text file to read and open it in read-only mode
set TextRead = objFSO.OpenTextFile(TextFile,ForReading)

row = 2 'start with row to set cell values

With SheetObject

    'format column as text
    .Range(.Columns(1),.Columns(15)).NumberFormat = "@"

    'set `H` headers since its always row 1
    .Cells(1, 1).Value = "Record Type"
    .Cells(1, 2).Value = "Sequence No"
    .Cells(1, 3).Value = "Contract No"
    .Cells(1, 4).Value = "Creation By"
    .Cells(1, 5).Value = "Transaction Date"
    .Cells(1, 6).Value = "Total Record"
    .Cells(1, 7).Value = "Total Amount"
    .Cells(1, 8).Value = "Source"
    .Cells(1, 9).Value = "Filler"

    Do Until TextRead.AtEndOfStream

        Line = TextRead.ReadLine

        If Left(Line,1) = "H" Then

            .Cells(row, 1).Value = Mid(Line, 1, 1)
            .Cells(row, 2).Value = Mid(Line, 2, 9)
            .Cells(row, 3).Value = Mid(Line, 11, 19) 
            .Cells(row, 4).Value = Mid(Line, 30, 1)
            .Cells(row, 5).Value = Mid(Line, 31, 8)
            .Cells(row, 6).Value = Mid(Line, 39, 9)
            .Cells(row, 7).Value = Mid(Line, 48, 17) 
            .Cells(row, 8).Value = Mid(Line, 65, 2)
            .Cells(row, 9).Value = Mid(Line, 67, 334)

            row = row +1

        ElseIf Left(Line,1) = "D" Then

            Dim bD 'as Boolean 

            If Not bD Then 'means its the first D row so set headers

                'now set 'D' headers because 'h' is finished
                .Cells(row, 1).Value = "Record Type"
                .Cells(row, 2).Value = "Sequence No"
                .Cells(row, 3).Value = "Contract No"
                .Cells(row, 4).Value = "Payment Type"
                .Cells(row, 5).Value = "Settlement Type"
                .Cells(row, 6).Value = "Effective Date"
                .Cells(row, 7).Value = "Credit Account No."
                .Cells(row, 8).Value = "Cr. Transaction Amount"
                .Cells(row, 9).Value = "Loan Type"
                .Cells(row, 10).Value = "Bank Employee ID"
                .Cells(row, 11).Value = "ID Number"
                .Cells(row, 12).Value = "ID Type Code"
                .Cells(row, 13).Value = "Bank Employee Name"
                .Cells(row, 14).Value = "HRIS Process Status"
                .Cells(row, 15).Value = "Total Record"
                .Cells(row, 16).Value = "CIF Number"
                .Cells(row, 17).Value = "Account Branch"

                'add 1 row to paste data again
                row = row + 1

                'set variable so code knows headers have been set
                bD = True

            End If

            .Cells(row, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
            .Cells(row, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
            .Cells(row, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C
            .Cells(row, 4).Value = Mid(Line, 30, 10) 
            .Cells(row, 5).Value = Mid(Line, 40, 1)
            .Cells(row, 6).Value = Mid(Line, 41, 8)      
            .Cells(row, 7).Value = Mid(Line, 49, 19) 
            .Cells(row, 8).Value = Mid(Line, 68, 1)
            .Cells(row, 9).Value = Mid(Line, 69, 17) 
            .Cells(row, 10).Value = Mid(Line, 86, 10) 
            .Cells(row, 11).Value = Mid(Line, 96, 40) 
            .Cells(row, 12).Value = Mid(Line, 136, 40) 
            .Cells(row, 13).Value = Mid(Line, 176, 3)
            .Cells(row, 14).Value = Mid(Line, 179, 200) 
            .Cells(row, 15).Value = Mid(Line, 379, 1)
            .Cells(row, 16).Value = Mid(Line, 380, 19)
            .Cells(row, 17).Value = Mid(Line, 399, 5)

            row = row  + 1 

        ElseIf Left(Line,1) = "T" Then

            Dim bT 'as Boolean 

            If Not bT Then 'means its the first T row so set headers

                'now set 'T' headers because 'D' is finished
                .Cells(row, 1).Value = "Record Type"
                .Cells(row, 2).Value = "Sequence No"
                .Cells(row, 3).Value = "Contract No"
                .Cells(row, 4).Value = "Total Record"
                .Cells(row, 5).Value = "Total Amount"
                .Cells(row, 6).Value = "Filler"

                'add 1 row to paste data again
                row = row + 1

                'set variable so code knows headers have been set
                bT = True

            End If

            .Cells(row, 1).Value = Mid(Line, 1, 1)
            .Cells(row, 2).Value = Mid(Line, 2, 9)
            .Cells(row, 3).Value = Mid(Line, 30, 9)
            .Cells(row, 4).Value = Mid(Line, 39, 17) 
            .Cells(row, 5).Value = Mid(Line, 65, 2)
            .Cells(row, 6).Value = Mid(Line, 56, 354)

            row = row + 1

        Else
            'catch errors 

        End If

     'to move down the Excel row to paste for each line in the text fix
    Loop

End With

'Save and quit
objWB.Save
objWB.Close
objExcel.Quit
Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

you are super genius, I didnt even think about it.How to become the same level as you man?LOL..Thanks a lot man..Really Appreciate it. :)
@user3143305 - Sometimes its hard to think of solutions when you are so close to the problem. It helps to have a 2nd pair of eyes :)

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.