Import multiple text file Excel VBA

Question

I want to store data in 1 worksheet from multiple .txt files. Also, I want the first cell to contain the file name not the file path (if possible) so I can link it to the graphs later on. There is also AT MOST 7 columns in the data while the number of rows is variable and each extra array is separated by one empty column.

Dim myFile As String
Dim myValue As Integer
Dim rData As Integer
Dim Data As String
Dim LineArray() As String
Dim DataArray() As String
Dim TempArray() As String

Dim Delimiter As String
Dim row As Integer
Dim counter As Integer
Dim counterArrSep As Integer
Dim FileName As String





Sub Button1_Click()

'Input number of blades
myValue = InputBox("Please enter the number of employees below", "number of employees", vbOKCancel)

'Cancel (doesn't work properly)
If myValue = 0 Then
    Exit Sub
End If

'Inputs
Delimiter = " "
row = 1

'Populate the table
Do While counter < myValue

'.txt file processing

'Show open file dialog box
myFile = Application.GetOpenFilename()

'Cancel
If myFile = "False" Then
    Exit Sub
End If

'Get file name (doesn't work)
 FileName = Dir(myFile, vbDirectory)
 Dim DataArray()
 DataArray(counterArrSep, 0) = FileName

'Open file
rData = FreeFile
Open myFile For Input As rData

'Store file content inside a variable
Data = Input(LOF(rData), rData)

'Close file
Close rData

'Separate Out lines of data
LineArray() = Split(Data, vbCrLf)


'Read Data into an Array Variable
For x = LBound(LineArray) To UBound(LineArray)

    If Len(Trim(LineArray(x))) <> 0 Then

    'Split up line of text by delimiter
        TempArray = Split(LineArray(x), Delimiter)

    'Determine how many columns are needed
        col = UBound(TempArray)

    'Re-Adjust Array boundaries
    ReDim Preserve DataArray(col, row)

    'Load line of data into Array variable
        For y = LBound(TempArray) To UBound(TempArray)
            DataArray(y + counterArrSep, row) = TempArray(y)
    Next y
End If

'Next line
  row = row + 1

Next x

'Clear array
Erase TempArray

'Increments the count to get another file
counter = counter + 1

'Adds space between each arrays in the Worksheet
counterArrSep = counterArrSep + 8

Loop
End Sub

The .txt files looks like this: ...\\employees\\John.txt

apples pears oranges carrots
4 5 34 2
43 5,5 4 43
6 54 9 7,5
41,5 55 0 2

...\employees\Steve.txt
apples pears oranges carrots cabbages
6 56 6 2 0
4 1 4 12 5
0 7 9 7 6
0 12 1 5 3
1 44 3 6 0
4 4 4,5 6 23

Answer 1

Main sub

Public Sub Main()
    Dim fd  As FileDialog
    Dim i   As Long

    Application.ScreenUpdating = False

    'set and determine file picker behaviour
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = True

    'Launch file picker, exit if no files selected. Hold Ctrl to select multiple files.
    If Not fd.Show = -1 Then Exit Sub

    'Import selected files, file by file.
    For i = 1 To fd.SelectedItems.Count
        Call OpenFileForInput(fd.SelectedItems(i))
    Next i
End Sub

Helper sub

Private Sub OpenFileForInput(ByVal FilePathAndName As String)
Dim DataInTransit   As String
Dim FileName        As String
Dim rData           As Integer
Dim Arr             As Variant

'extract the filename
FileName = StrReverse(Left(StrReverse(FilePathAndName), _
            InStr(1, StrReverse(FilePathAndName), "\") - 1))

rData = FreeFile
Open FilePathAndName For Input As #rData
    Do While Not EOF(rData)
        Line Input #rData, DataInTransit

        ' ##################################################
        ' This is where the data gets into the worksheet, line by line for each file.
        ' Modify to suit your needs
            DataInTransit = FileName & " " & DataInTransit
            Arr = Split(DataInTransit, " ")
            ActiveCell.Resize(1, UBound(Arr) + 1) = Split(DataInTransit, " ")
            ActiveCell.Offset(1).Activate
        ' ##################################################

    Loop
Close #rData
End Sub

I'd choose not to use heavily on arrays but to treat worksheet range like arrays. Hence pasting the line directly into ActiveCell and then move ActiveCell one row below.

I extracted the code from one of my old project which import hundreds of thousands of lines into the worksheet. It completes within a minute, hence still its quite fast, although the way I import each line isn't elegant.

Hope this helps.