Consulting

Results 1 to 3 of 3

Thread: Export to Txt File - Amount should be right justified

  1. #1
    VBAX Tutor gnod's Avatar
    Joined
    Apr 2006
    Posts
    257
    Location

    Export to Txt File - Amount should be right justified

    i use this code from mark007 to create a fixed width text file. thanks mark007
    http://vbaexpress.com/kb/getarticle.php?kb_id=759


    on my scenario, the payment amount column should be right justified when i export it to text file.. also the amount should include the 2 decimal places for centavos..

    for example, in the excel file the amount of 100000 (6 digits), when exported it should be 10000000 (8 digits) including the decimal places

    another example, if it 100000.25 when exported it should be 10000025 (including the 2 decimal places without the period (.))

    i attach my excel file for your reference..


    Thanks..

  2. #2
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    Maybe try changing this line ...

    [vba]strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))[/vba]

    .. to this ..

    [vba]strLine = strLine & String$(s(j) - Len(strCell), Chr$(32)) & strCell[/vba]

  3. #3
    VBAX Tutor gnod's Avatar
    Joined
    Apr 2006
    Posts
    257
    Location
    Thanks for reply firefytr. I'll try your code. This is what I did in ExtractToTxtFile procedure.

    [vba]
    Sub ExportToTxtFile()
    Dim intRow As Integer, intTempRow As Integer, intFieldCounter As Integer, i As Integer, _
    intDifference As Integer
    Dim strPathFilename As String, strFilename As String, strPaymentAmount As String
    Dim strLine As String, strCell As String
    Dim blnHasPeriod As Boolean, blnHas1Decimal As Boolean, blnHas2Decimal As Boolean
    Dim s(7) As Integer
    Dim fNum As Long

    fNum = FreeFile

    strFilename = "Payments.txt"
    strPathFilename = ThisWorkbook.Path & "\" & strFilename
    s(0) = 10
    s(1) = 10
    s(2) = 35
    s(3) = 35
    s(4) = 10
    s(5) = 12
    s(6) = 12
    s(7) = 15

    Open strPathFilename For Output As fNum

    With Worksheets("EPCIB_Uploading")
    Application.ScreenUpdating = False
    If .Range("StartRow_Done").Value = "" Then
    intTempRow = .Range("StartRow_Done").Row
    Else
    intTempRow = .Cells(65536, 9).End(xlUp).Row + 1
    End If
    For intRow = intTempRow To .Cells(65536, 1).End(xlUp).Row
    strLine = ""
    For intFieldCounter = 0 To UBound(s)
    strPaymentAmount = ""
    blnHasPeriod = False
    blnHas1Decimal = False
    blnHas2Decimal = False
    If intFieldCounter = 4 Or intFieldCounter = 7 Then
    For i = 1 To Len(.Cells(intRow, intFieldCounter + 1).Value)
    NextChar:
    If Mid(.Cells(intRow, intFieldCounter + 1).Value, i, 1) <> "." Then
    strPaymentAmount = strPaymentAmount & Mid(.Cells(intRow, intFieldCounter + 1).Value, i, 1)
    Else
    blnHasPeriod = True
    If (Len(.Cells(intRow, intFieldCounter + 1).Value) - i) > 1 Then
    blnHas2Decimal = True
    Else
    blnHas1Decimal = True
    End If
    i = i + 1
    GoTo NextChar
    End If
    Next i
    If blnHasPeriod Then
    If blnHas2Decimal Then
    strCell = Left$(strPaymentAmount, s(intFieldCounter))
    intDifference = s(intFieldCounter) - Len(strCell)
    For i = 1 To intDifference
    strCell = " " & strCell
    Next i
    Else
    strCell = Left$(strPaymentAmount & "0", s(intFieldCounter))
    intDifference = s(intFieldCounter) - Len(strCell)
    For i = 1 To intDifference
    strCell = " " & strCell
    Next i
    End If
    Else
    strCell = Left$(strPaymentAmount & "00", s(intFieldCounter))
    intDifference = s(intFieldCounter) - Len(strCell)
    For i = 1 To intDifference
    strCell = " " & strCell
    Next i
    End If
    Else
    strCell = Left$(.Cells(intRow, intFieldCounter + 1).Value, s(intFieldCounter))
    intDifference = s(intFieldCounter) - Len(strCell)
    For i = 1 To intDifference
    strCell = " " & strCell
    Next i
    End If
    strLine = strLine & strCell & String$(s(intFieldCounter) - Len(strCell), Chr$(32))
    .Cells(intRow, intFieldCounter + 1).Locked = True
    .Cells(intRow, intFieldCounter + 1).Interior.ColorIndex = 15
    Next intFieldCounter
    .Cells(intRow, 9) = "done"
    Print #fNum, strLine
    Next intRow

    Application.ScreenUpdating = True
    MsgBox "Finished exporting the data to " & strFilename, vbInformation, "Export"
    End With

    Close #fNum
    End Sub
    [/vba]
    If you can simplify my code, I appreciate. Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •