Nxjerrja e të dhënave nga një numër i madh skedarësh teksti në Excel

Konfigurimi: Në një skedar test.txt:

Skedarët e tjerë të tekstit me të njëjtën plan urbanistik u krijuan në të njëjtin direktori.

Në një fletëllogaritëse vini re titujt e kolonave të qelizave dhe vendndodhjen aktive të qelizës.

Kodi i skedarit të vetëm mbështillet me kod që lexon skedarë të shumtë më pas thërret kodin e skedarit të vetëm. Në këtë shembull përdor të gjithë skedarët e tekstit. (test*.txt) me test për fillimin e emrit të tyre.

Sub TxtFiles()
    Dim strFileName As String
    Dim strFolder As String
    Dim strFileSpec As String

    'TODO: Specify path spec
    strFolder = "C:\Users\007\Documents\Programming\VBA\Excel"
    'TODO: Specify file spec
    strFileSpec = strFolder & "\test*.txt"

    strFileName = Dir(strFileSpec)
    Do While Len(strFileName) > 0
        Call ImportTextFile(strFileName, "|")
        'move active cell location to next available empty cell row in column A.
        Range("A1").End(xlDown).Offset(1, 0).Select
        'Read next filename
        strFileName = Dir
    Loop
End Sub

Kodi i mësipërm thërret kodin e mëposhtëm nga ImportTextFile:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportTextFile
' This imports a text file into Excel.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ImportTextFile(FName As String, Sep As String)

    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim TempVal As Variant
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim SaveColNdx As Integer

    Application.ScreenUpdating = False
    On Error GoTo EndMacro:

    SaveColNdx = ActiveCell.Column
    RowNdx = ActiveCell.Row

    Open FName For Input Access Read As #1

    While Not EOF(1)
        Line Input #1, WholeLine
        If Right(WholeLine, 1) <> Sep Then
            WholeLine = WholeLine & Sep
        End If
        ColNdx = SaveColNdx
        Pos = 1
        NextPos = InStr(Pos, WholeLine, Sep)
        While NextPos >= 1
            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
            Cells(RowNdx, ColNdx).Value = TempVal
            Pos = NextPos + 1
            ColNdx = ColNdx + 1
            NextPos = InStr(Pos, WholeLine, Sep)
        Wend
        RowNdx = RowNdx + 1
    Wend

EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close #1
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END ImportTextFile
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Rezultati përfundimtar do të duket si: