VBA Convert delimiter text file to Excel

2019-07-16 10:27发布

问题:

I have a code that convert files in folder from .txt (with "|" separator) to xslx, But the code works fine for some files (when I open it in excel), the others are wrong, when I try to import the wring one manually by excel ribbon(Get external data -- > from text), the files are correct.

This is my code :

Sub tgr()

    Const txtFldrPath As String = "C:\...\txtFiles"     
    Const xlsFldrPath As String = "C:\excelFiles"     

    Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "*.txt")
    Dim strLine() As String
    Dim LineIndex As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    While CurrentFile <> vbNullString
        LineIndex = 0
        Close #1
        Open txtFldrPath & "\" & CurrentFile For Input As #1
        While Not EOF(1)
            LineIndex = LineIndex + 1
            ReDim Preserve strLine(1 To LineIndex)
            Line Input #1, strLine(LineIndex)
        Wend
        Close #1

        With ActiveSheet.Range("A1").Resize(LineIndex, 1)
            .Value = WorksheetFunction.Transpose(strLine)
            .TextToColumns Other:=True, OtherChar:="|"
        End With

        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xlsx"), xlOpenXMLWorkbook
        ActiveWorkbook.Close False
        ActiveSheet.UsedRange.ClearContents

        CurrentFile = Dir
    Wend
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

this picture show the result in excel and the original file .txt

回答1:

First off, you have bad data. There is a tab character between Total liabilities and 30,619,676.00 in AI060616.txt. Excel doesn't like tabs in cell content. In fact, the tab character is the default delimiter on a TextToColumns command and this translates into two column of data when the array is brought in.

    Open txtFldrPath & "\" & CurrentFile For Input As #1
    While Not EOF(1)
        LineIndex = LineIndex + 1
        ReDim Preserve strLine(1 To LineIndex)
        Line Input #1, strLine(LineIndex)
        'STRIP TABS OUT AND REPLACE WITH A SPACE!!!!!
        strLine(LineIndex) = Replace(strLine(LineIndex), Chr(9), Chr(32))
    Wend
    Close #1

Next, the Range.TextToColumns method 'remembers' all of the settings that were used the last time it was run through; it doen't matter whether that was by the user on hte worksheet or through VBA. You need many more parameters than you have supplied in order to guarantee that it is going to operate the way you want.

    With ActiveSheet.Range("A1").Resize(LineIndex, 1)
        .Value = WorksheetFunction.Transpose(strLine)
        'DEFINE THE OPERATION FULLY!!!!
        .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
                       Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
                       Other:=True, OtherChar:="|"
    End With



回答2:

While I do not understand the solution / problem yet, it seems that it is solved if you apply the .TextToColumns method twice:

With ActiveSheet.Range("A1").Resize(LineIndex, 1)
    .Value = WorksheetFunction.Transpose(strLine)
    .TextToColumns Other:=True, OtherChar:="|"
    .TextToColumns Other:=True, OtherChar:="|"
End With

Maybe someone else can clarify why that is. While this is not the kind of post I normally provide, the above should give you a workaround while someone else comes up with a better solution (including an explanation).



回答3:

The file AI150616 has in the column "B" the data 30,619,676.00 Net worth = ZAR 83,456,466.00 Hence, final required BG should be (63,503,915.82)
Delimiter only works with one column. Should that be allowable? If not, another procedure may be needed to check if data is correct , if so, append it, else, warn the user data has been compromised somehow.