Merging text files in Excel 2013 - vba

Question

New at Excel macros so need some help. I have about 60+ text files in a single directory each with just one column of data. I am trying to get/write a macro that will import all the text files but also add a second column that contains the file name.
I have the 2 steps I am trying to do. First Sub gets me the list of file names, the second sub gets my the content of the txt files. So the end result I am looking for is a single sheet with the txt content in column A and the source file's name in column B. I am struggling to get the file name in. The files imports must fallow below each other.
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
xRow = xRow + 1
xFname$ = Dir
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & xFname$, Destination:=Range("$A$1"))
End With
Loop
End If
End With
End Sub
Sub TextContent()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="Text Files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End (xlUp).Offset(1, 0))
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub
Sub FileList()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
xRow = xRow + 1
xFname$ = Dir
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & xFname$, Destination:=Range("$A$1"))
End With
Loop
End If
End With
End Sub
Sub TextContent()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="Text Files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End (xlUp).Offset(1, 0))
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub

Answer 1

Something like this should do what you want.
Sub ImportTextFiles()
Dim myFile As String, text As String, textline As String
Dim iRow As Long
Application.ScreenUpdating = False
For iRow = 1 To Range("B" & Rows.Count).End(xlUp).Row
' Reset the text variable
text = ""
' Compose the full path
myFile = Range("A" & iRow).Value & "\" & Range("B" & iRow).Value
' Open the file
Open myFile For Input As #1
' Loop through the lines of the file
Do Until EOF(1)
' Read a line
Line Input #1, textline
' Concatenate text
text = text & " " & textline
Loop
' Close the file
Close #1
' Write text to cell
Range("C" & iRow).Value = Mid(text, 2)
Next iRow
Application.ScreenUpdating = True
End Sub
Feel free to modify the script to suit your specific needs. Keep in mind, you can do pretty much whatever you want to do...