PDA

View Full Version : Multiple text file importing



Davorito
11-24-2015, 06:14 AM
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
11-24-2015, 04:18 PM
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
11-27-2015, 07:13 AM
Can't select any files. It only lets me choose folders.

snb
11-27-2015, 08:07 AM
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
11-28-2015, 12:21 PM
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
11-29-2015, 03:22 AM
Remove the dot:

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

Tom Jones
11-29-2015, 04:21 AM
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
11-29-2015, 04:29 AM
stares you in the face:

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