Multiple text file importing

[Davorito]

Hi guys,


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 the first column of each array is separated by 7 columns.

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 employees
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 + 7


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



Expected result

John.txt								Steve.txt
apples	pears	oranges	carrots					apples	pears	oranges	carrots	cabbages
4	5	34	2					6	56	6	2	0
43	5,5	4	43					4	1	4	12	5
6	54	9	7,5					0	7	9	7	6
41,5	55	0	2					0	12	1	5	3
								1	44	3	6	0
								4	4	4,5	6	23

[Leith Ross]

Hello Davorito,

This macro worked for me using the examples you provided and produces an output as above. The attached workbook has the macro added to it. If you have any questions, please ask. I will be happy to answer them.

Sub ImportTextFiles()

    Dim Data()      As Byte
    Dim Fields      As Variant  ' These are the columns in the Text File.
    Dim Files       As Object
    Dim FilePath    As String
    Dim FieldWidth  As Integer  ' Maximum width of columns in a text file.
    Dim FolderPath  As Variant
    Dim FS          As String   ' Field Separator - character used to separate the data in the text file.
    Dim LineCount   As Long
    Dim Lines       As Variant
    Dim LS          As String   ' Line Separator character.
    Dim Rng         As Range
    Dim RngBeg      As Range
    Dim RngEnd      As Range
    Dim oFolder     As Object
    Dim oShell      As Object
    Dim Text        As String
    Dim Wks         As Worksheet
    
        FS = Chr(32)
        LS = vbCrLf
        FieldWidth = 7
        
      ' Assign the worksheet to receive the output and clear it.
        Set Wks = Worksheets("Sheet1")
            Wks.UsedRange.ClearContents
        
      ' Assign the starting cell on the worksheet.
        Set RngBeg = Wks.Range("A1")
        
      ' Choose the folder with the text files to open.
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then
                FolderPath = .SelectedItems(1)
            Else
                Exit Sub    ' User cancelled.
            End If
        End With
        
        Application.ScreenUpdating = False
        
        Set oShell = CreateObject("Shell.Application")
        
        Set oFolder = oShell.Namespace(FolderPath)
        
        Set Files = oFolder.Items
        
          ' Return all Text Files in this folder.
            Files.Filter 64, "*.txt"
            
            For n = 0 To Files.Count - 1
                FilePath = Files.Item(n).Path
                
                Open FilePath For Binary Access Read As #1
                    ReDim Data(LOF(1))
                    Get #1, , Data
                Close #1
                
                Text = StrConv(Data, vbUnicode)
                Text = Left(Text, Len(Text) - 1)
                
                Lines = Split(Text, LS)
                
                  ' Define the output Range size.
                    Set RngEnd = RngBeg.Resize(UBound(Lines) - RngBeg.Row + 2, FieldWidth)
                    Set Rng = Wks.Range(RngBeg, RngEnd)
                
                  ' Current line of the text file being processed.
                    LineCount = 0
                    
                  ' Add the file name to the first row.
                    Rng.Rows(1).Cells(1, 1).Value = Files.Item(n)
                    
                    For Row = 2 To Rng.Rows.Count
                        Fields = Split(Lines(LineCount), FS)
                        Rng.Rows(Row).Resize(1, UBound(Fields) + 1).Value = Fields
                        LineCount = LineCount + 1
                    Next Row
                    
              ' Move the starting column by the FieldWidth + 1.
                Set RngBeg = RngBeg.Offset(0, FieldWidth + 1)
                
            Next n
            
        Application.ScreenUpdating = True
            
End Sub

[Davorito]

Can't select any files. It only lets me choose folders.

[snb]

sub M_snb()
  sn=split(createobject("wscript.shell").exc("cmd /c Dir G:\OF\*.txt /b").stdout.readall,vbcrlf)
  
  for j=0 to ubound(sn)-1
    sp=split(createobject("scripting.filesystemobject").opentextfile("G:\OF\" & sn(j)).readall,vbcrlf)

    with thisworkbook.sheets(1).cells(1,.columns.count).end(xltoleft).offset(,7)
      .resize((ubound(sp))=application.transpose(sp)
      .currentregion.texttocolumns ,,,,0,-1,0,0,0
    end with
  Next
End Sub

[Tom Jones]

For me Leith Roos code work well.

snb code gave error "Invalid or unqualified references" and highlights .Columns.Count from
With ThisWorkbook.Sheets("Sheet3").Cells(1, .Columns.Count).End(xlToLeft).Offset(, 7)

snb, can you fix it?
Thanks

[snb]

Remove the dot:

ThisWorkbook.Sheets("Sheet3").Cells(1, Columns.Count).End(xlToLeft).Offset(, 7)

[Tom Jones]

I tried this out before posting (#4) and I had the following error:
Object does not support this property or method (Error 438) and showed me among this:
sn = split (CreateObject ("wscript.shell"). exc ("cmd /c Dir D:\TEXT \ *. txt /b").stdout.readall,vbcrlf)

[snb]

stares you in the face:

sn = split (CreateObject ("wscript.shell"). exec ("cmd /c Dir D:\TEXT \ *. txt /b").stdout.readall,vbcrlf)