I am using the following code to scan a directory for text files.
It then imports all the data from each text file. At the moment my data is being imported scrambled with each word placed in a different row and column.
What I am wanting is each line of text per text file to be inserted into different columns in one row.
So text file 1 might contain:
A Cat
Mark Spence
Birmingham
And when imported into excel it should read:
A B C
A Cat Mark Spence Birmingham
then text file 2 would be inserted into the next row below.
so text file 2:
A Dog
David Gray
Manchester
Result:
A B C
A Cat Mark Spence Birmingham
A Dog David Gray Manchester
Please can someone show me where I am going wrong with this? Thanks
Sub Import_All_Text_Files_2007()
Dim nxt_row As Long
'Change Path
Const strPath As String = "Z:\NS\Unactioned\"
Dim strExtension As String
'Stop Screen Flickering
Application.ScreenUpdating = False
ChDir strPath
'Change extension
strExtension = Dir(strPath & "*.txt")
Do While strExtension <> ""
'Adds File Name as title on next row
Range("A1").Value = strExtension
'Sets Row Number for Data to Begin
nxt_row = Range("A1").End(xlUp).Offset(1, 0).Row
'Below is from a recorded macro importing a text file
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row))
.Name = strExtension
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
'Delimiter Settings:
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "="
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub
Instead of QueryTables, use:
FileNum = FreeFile()
curCol = 1
Open strPath & strExtension For Input As #FileNum
While Not EOF(FileNum)
Line Input #FileNum, DataLine
ActiveSheet.Cells(nxt_row,curCol) = DataLine
curCol = curCol + 1
Wend
Close #FileNum
I didn't test it, but it should at least guide you.
Related
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
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...
Hey so i found a specific query to import a file into excel from a specific row and delete the following datga each time you open it again. but is it also pssible to stop adding rows at a specific line? and is it possible to leave some rows out if there for example is a specific word in that line?
Sub Sample()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\sample.txt", Destination:=Range("$A$1") _
)
.Name = "Sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
You can do it, but not with a Querytable.
Try this code:
Private Sub Open_Click()
Dim fn As Variant, myLine As Long, txt As String, x As Variant, ouput As String
Dim i As Integer, j As Integer: j = 1
Dim sht As Worksheet
Set sht = Worksheets("Sheet1") 'Modify Sheet Name
fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
"Open File")
If fn = False Then Exit Sub
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
x = Split(txt, vbNewLine)
For i = 0 To UBound(x)
If x(i) <> "SomeCriteria" Then 'Check for some criteria
sht.Cells(j, 1).Value = x(i)
j = j + 1
End If
Next i
End Sub
So what it does basically, it opens a user selected txt file and stores it in the variable txt. Do seperate the rows you can use the split-function. Now each line is stored in an array x. You could go trough the array/each line and take out the ones you want. To check if a specific word is in a line, use the InStr-function.
I need to read the following text document (see first picture):
and place data into an excel document in the pictured manner (see second image):
I want to do this with an Excel VBA macros but I do not have the slightest idea on how to do so. I am very new to excel VBA and I do not have the slightest idea on where to begin.
Use following sub.
Sub txtImport()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\HARUN\Documents\Test.txt", Destination:=Range("$A$1"))
.Name = "Test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
This code will do that without looping and regardless of number of spaces between the columns.
Sub Test()
Dim Fn As String, WS As Worksheet, st As String
Fn = "D:\tttt\test.txt" ' the file path and name
Set WS = Sheets("Sheet1")
'Read text file to st string
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(Fn) Then
MsgBox Fn & " : is missing."
Exit Sub
Else
If FileLen(Fn) = 0 Then
MsgBox Fn & " : is empty"
Exit Sub
Else
With .OpenTextFile(Fn, 1)
st = .ReadAll
.Close
End With
End If
End If
End With
'Replace every one or more space in st string with vbTab
With CreateObject("VBScript.RegExp")
.Pattern = "[ ]+"
.Global = True
.Execute st
st = .Replace(st, vbTab)
End With
'Put st string in Clipboard
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText st
.PutInClipboard
End With
'Paste Clipboard to range
WS.Range("A1").PasteSpecial
End Sub
Let's suppose you have csv file (like you have shown, just difference is in delimiters), then the code should be:
Sub ReadData()
Dim line, array() As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set rfile = FSO.OpenTextFile(*your full path to the file*, 1) 'connection for reading
Dim i As Integer
i = 1
Do Until rfile.AtEndOfStream
line = rfile.ReadLine
array = Split(line, ",") 'I assumed that delimiter is comma
For j = 0 To UBound(array)
Cells(i, j + 1).Value = array(j)
Next j
i = i + 1
Loop
rfile.Close
End Sub
I am trying to write a VBA macro that will prompt the user to choose a directory immediately after running it.
Once the user chooses a directory, the macro will scan through all the *.txt files in it and put each of its contents in new row under column G. So, the contents of 1st text file will be in G2, second text file in G3 and so on.
I browsed StackOverFlow for long and found a working code
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
I also did some very poor hard-coding to import just one text file into cell G2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\K\record001_001.txt" _
, Destination:=Range("$G$2"))
.Name = "record001_001"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
I do not know how to put these pieces together to have a working code that will.
Read all the txt files inside the directory I choose.
Put each of the text files content in a new row of the same worksheet (G2, G3, etc.)
Each of those text files have just one or two rows of data and do not want anything to be delimited there. Just copy the whole lot of text in the txt file and paste it in G2, in a loop until all txt files in the selected directory are done.
To Read all the txt files inside the directory or to choose one file
The following code should let you choose one or multiple files you want to Import
Application.FileDialog Property (Excel)
'// Open Dailog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True <-- Allow multiple selection
.Show '<-- display the files
End With
To set Row Number for Data to Begin at G2 then next
If need update the following code
nRow = Range("G2").End(xlUp).Offset(1, 0).row
Destination:=Range("$G$" & nRow))
See complete CODE with comments
Sub Import()
'// Declare a variable as
Dim nRow As Long
Dim sExtension As String
Dim oFolder As FileDialog '// FileDialog object
Dim vSelectedItem As Variant
'// Stop Screen Flickering
Application.ScreenUpdating = False
'// Create a FileDialog object as a File Picker dialog box
Set oFolder = Application.FileDialog(msoFileDialogOpen)
'// Use a With...End With block to reference FileDialog.
With oFolder
'// Allow multiple selection.
.AllowMultiSelect = True
'// Use the Show method to display the files.
If .Show = -1 Then
'// Extension
sExtension = Dir("*.txt")
'// Step through each SelectedItems
For Each vSelectedItem In .SelectedItems
'// Sets Row Number for Data to Begin
nRow = Range("G2").End(xlUp).Offset(1, 0).row
'// Below is importing a text file
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sExtension, Destination:=Range("$G$" & nRow))
.Name = sExtension
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "="
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
sExtension = Dir
Next
'// If Cancel...
Else
End If
End With
Application.ScreenUpdating = True
'// Set object to Nothing. Object? see Link Object
Set oFolder = Nothing
End Sub
Set Object = Nothing
How do I do this? Basically I want my multiple CSV files to be imported to multiple worksheet but in a single workbook only. Here's my VBA code that I want to loop. I need the loop to query all the CSV in C:\test\
Sub Macro()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\test\test1.csv", Destination:=Range("$A$1"))
.Name = "test1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
This guy absolutely nailed it. Very concise code and works perfectly for me on 2010. All credit goes to him (Jerry Beaucaire). I found it from a forum here.
Option Explicit
Sub ImportCSVs()
'Author: Jerry Beaucaire
'Date: 8/16/2010
'Summary: Import all CSV files from a folder into separate sheets
' named for the CSV filenames
'Update: 2/8/2013 Macro replaces existing sheets if they already exist in master workbook
Dim fPath As String
Dim fCSV As String
Dim wbCSV As Workbook
Dim wbMST As Workbook
Set wbMST = ThisWorkbook
fPath = "C:\test\" 'path to CSV files, include the final \
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'no error messages, take default answers
fCSV = Dir(fPath & "*.csv") 'start the CSV file listing
On Error Resume Next
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file
wbMST.Sheets(ActiveSheet.Name).Delete 'delete sheet if it exists
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr
Columns.Autofit 'clean up display
fCSV = Dir 'ready next CSV
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
Beware, this does not handles errors like you would have a duplicate sheet name if you imported a csv.
This uses early binding so you need to Reference Microsoft.Scripting.Runtime under Tools..References in the VBE
Dim fs As New FileSystemObject
Dim fo As Folder
Dim fi As File
Dim wb As Workbook
Dim ws As Worksheet
Dim sname As String
Sub loadall()
Set wb = ThisWorkbook
Set fo = fs.GetFolder("C:\TEMP\")
For Each fi In fo.Files
If UCase(Right(fi.name, 4)) = ".CSV" Then
sname = Replace(Replace(fi.name, ":", "_"), "\", "-")
Set ws = wb.Sheets.Add
ws.name = sname
Call yourRecordedLoaderModified(fi.Path, ws)
End If
Next
End Sub
Sub yourRecordedLoaderModified(what As String, where As Worksheet)
With ws.QueryTables.Add(Connection:= _
"TEXT;" & what, Destination:=Range("$A$1"))
.name = "test1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
You can use Dir to filter out and run with just the csv files
Sub MacroLoop()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("c:\test\*.csv")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "C:\test\" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
I had 183 csv files to condense into one workbook, one worksheet per csv file to facilitate analysis of the data and did not want to manually do this one at a time. I tried the highest rated solution on this question but had the same problem as another user; the csv files would open, but nothing would be inserted to the target workbook. I spent some time and adjusted the code so that it works as in Excel 2016. I haven't tested on older versions. I have not coded in Visual Basic in ages so there's probably a ton of room for improvement in my code, but it worked for me in a pinch. In case anyone happens to stumble upon this question as I did, I'm pasting the code I used below.
Option Explicit
Sub ImportCSVs()
'Author: Jerry Beaucaire
'Date: 8/16/2010
'Summary: Import all CSV files from a folder into separate sheets
' named for the CSV filenames
'Update: 2/8/2013 Macro replaces existing sheets if they already exist in master workbook
'Update: base script as seen in: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/merge-functions/csvs-to-sheets
'Update: adjusted code to work in Excel 2016
Dim fPath As String
Dim fCSV As String
Dim wbName As String
Dim wbCSV As Workbook
Dim wbMST As Workbook
wbName = "this is a string"
Set wbMST = ThisWorkbook
fPath = "C:\pathOfCSVFiles\" 'path to CSV files, include the final \
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'no error messages, take default answers
fCSV = Dir(fPath & "*.csv") 'start the CSV file listing
On Error Resume Next
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file
If wbName = "this is a string" Then 'this is to check if we are just starting out and target workbook only has default Sheet 1
wbCSV.Sheets.Copy After:=wbMST.Sheets(1) 'for first pass, can leave as is. if loading a large number of csv files and excel crashes midway, update this to the last csv that was loaded to the target workbook
Else
wbCSV.Sheets.Copy After:=wbMST.Sheets(wbName) 'if not first pass, then insert csv after last one
End If
fCSV = Dir 'ready next CSV
wbName = ActiveSheet.Name 'save name of csv loaded in this pass, to be used in the next pass
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
I didn't try this, but I'd go with this:
Dim NumFound As Long
With Application.FileSearch
.NewSearch
.LookIn = "C:\test\"
.FileName = "*.csv"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & "C:\test\" & (Application.FileSearch.FoundFiles(i)), Destination:=Range("$A$1"))
...
End With
Sheets.Add After:=Sheets(Sheets.Count)
Next i
End If
End With