How can VBA read CSV with breakline inside double quote? - vba

I'm trying to upload a CSV file with breaklines inside quotes (data.csv) but instead of putting all the text inside the quote in one cell, it still considers it as a new row.
When I open the CSV directly, everything works fine but when I run it through VBA, everything is getting messed up.
data.csv sample
cases,"variant:
option1: 0333102
option2: 1133202
option3: 4234442"
make-shift,"variant:
option1: shift iron
option2: workload
option3: network map
option4: lesson map"
Import_CSV Function
Function import_CSV(location As String, row As Integer, col As String) As Variant
Dim ws As Worksheet, strFile As String
Sheets("data").Visible = True
Sheets("data").UsedRange.ClearContents
Set ws = Sheets("data")
strFile = location
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.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 = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
import_CSV = Sheets("data").Range(col & "1:" & Get_C(Last_C(row, "data")) & Last_R(Get_C(Last_C(row, "data")), "data"))
Sheets("data").Visible = False
End Function

Assuming your import_CSV() returns the range in data worksheet with same size as the imported CSV, try below. Don't really need the row integer and col string, so I have omitted it.
Option Explicit
Function ImportCustomCSV(location As String) As Range
Dim oWbCSV As Workbook, oRngCSV As Range, oRngData As Range
ThisWorkbook.Worksheets("data").UsedRange.ClearContents
' Range to start pasting csv data
Set oRngData = ThisWorkbook.Worksheets("data").Range("A1")
' Assumes file availability is already checked
Set oWbCSV = Workbooks.Open(Filename:=location, ReadOnly:=True)
Set oRngCSV = oWbCSV.Worksheets(1).UsedRange
' Copy the CSV range to data worksheet
oRngCSV.Copy oRngData
' Make the data range the same rows and cols as imported csv
Set oRngData = oRngData.Resize(oRngCSV.Rows.Count, oRngCSV.Columns.Count)
' Cleanup
Set oRngCSV = Nothing
oWbCSV.Close SaveChanges:=False
Set oWbCSV = Nothing
' Return the updated data range
Set ImportCustomCSV = oRngData
End Function

Related

How would I open a .csv file with VBA and read all the data?

When I extract my data from this one software into raw text it separates the values with commas and quotation marks for the majority of the file. Except in certain cases the data has a line break. When I save it as a .csv and open it, the data is cleanly formatted into a proper table.
However, if I attempt the same process with QueryTablesit processes the enter character as a new line.
I have two different approaches in two different subprograms
The first is able to read the number of rows and columns properly, but since it uses the QueryTables method it reads that enter charachter as a new line.
The code for this approach is below:
Private Sub OpenCSVFile()
With ThisWorkbook
Set primeSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
primeSheet.Name = "Temp"
End With
Set informationRange = primeSheet.Range("A1")
xAddress = informationRange.Address
With primeSheet.QueryTables.Add("TEXT;" & strPath, primeSheet.Range(xAddress))
.AdjustColumnWidth = False
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SaveData = False
.RefreshPeriod = 0
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
rowLength = primeSheet.Cells(1, Columns.Count).End(xlToLeft).Column
colLength = primeSheet.Cells(Rows.Count, "A").End(xlUp).Row
End Sub
The other method keeps the formatting intact as to when I regularly open .csv files of my extracted data, but it is unable to read the number of rows and lengths, and returns a value for 1 for each.
Private Sub OpenCSV()
Set primeBook = Workbooks.Open(strPath)
With primeBook
rowLength = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
colLength = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
End With
Set informationRange = Sheet1.Range("A1", Sheet1.Cells(colLength, rowLength))
End Sub
How would you recommend I address my issue and read the contents of the csv file while ensuring no weird line breaks.
Would this work?
Private Sub OpenCSV()
Set primeBook = Workbooks.Open(strPath)
With primeBook.Sheet1
rowLength = .usedrange.rows.count
colLength = .usedrange.columns.count
End With
Set informationRange = Sheet1.Range("A1", Sheet1.Cells(colLength, rowLength))
End Sub

Want to import bits (a couple of rows) of an .txt to excel

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.

Excel VBA - Import CSV without data connection

I'm hoping to use this bit of connection style VBA code to import a number of CSV files. When I used the connection wizard, it downloads the CSV exactly in the table format I need it in etc, so I'm hoping to avoid doing a string reader...
Is there a way to do something like the following, but without creating a permanent connection?
Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;T:\XYZ\KCross\Output\alpha.csv", Destination:=range("$B$2" _
))
.name = "alpha_1"
.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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
I saw this on SO a few days ago . . .
' Merge data from multiple sheets into seperate sheets
Sub R_AnalysisMerger2()
Dim WSA As Worksheet
Dim bookList As Workbook
Dim SelectedFiles As Variant
Dim NFile As Long
Dim FileName As String
Dim Ws As Worksheet, vDB As Variant, rngT As Range
Dim vFn, myFn As String
Application.ScreenUpdating = False
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)
If IsEmpty(SelectedFiles) Then Exit Sub
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
FileName = SelectedFiles(NFile)
vFn = Split(FileName, "\")
myFn = vFn(UBound(vFn))
myFn = Replace(myFn, ".csv", "")
Set bookList = Workbooks.Open(FileName, Format:=2)
Set WSA = bookList.Sheets(1)
vDB = WSA.UsedRange
bookList.Close (0)
Set Ws = Sheets.Add(after:=Sheets(Sheets.Count))
ActiveSheet.Name = myFn
Ws.Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
Next
Application.ScreenUpdating = True
End Sub
' Merge data from multime files into one sheet.
Sub R_AnalysisMerger()
Dim WSA As Worksheet
Dim bookList As Workbook
Dim SelectedFiles() As Variant
Dim NFile As Long
Dim FileName As String
Dim Ws As Worksheet, vDB As Variant, rngT As Range
Application.ScreenUpdating = False
Set Ws = ThisWorkbook.Sheets(1)
Ws.UsedRange.Clear
'change folder path of excel files here
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
FileName = SelectedFiles(NFile)
Set bookList = Workbooks.Open(FileName, Format:=2)
Set WSA = bookList.Sheets(1)
With WSA
vDB = .UsedRange
Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
If rngT.Row = 2 Then Set rngT = Ws.Range("a1")
rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
bookList.Close (0)
End With
Next
Application.ScreenUpdating = True
Ws.Range("A1").Select
End Sub
It's not the most Object-Oriented solution (ideally we'd want to point at that specific connection by name or as an attribute of the QueryTable and delete it).
I noticed that when we create the Query Table the connection is added to the "Workbook.Connections" class as the last connection. This lets us take a count of the connections, pass it back to the connections class to point at this connection, then delete it.
This solution will only work if you want to delete the connection immediately with the creation of the Query Table. If you want to delete the connection at a later time for some reason, it looks like the connection name is derived from the csv workbook name, so you could always approach it that way too (ie pass the workbook name as an parameter to the connections class to reference it).
Assuming we want to delete immediately, the solution works like this:
Get the count of connections (ThisWorkbook.Connections.Count)
Pass it as an index parameter to the connections class (ThisWorkbook.Connections(ThisWorkbook.Connections.Count))
Call the .Delete method on the Connections class (ThisWorkbook.Connections(ThisWorkbook.Connections.Count).Delete)
Using your provided code, I'd add this line of code at the end of the sub like so:
Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;T:\XYZ\KCross\Output\alpha.csv", Destination:=range("$B$2" _
))
.name = "alpha_1"
.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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ThisWorkbook.Connections(ThisWorkbook.Connections.Count).Delete
End Sub
Another way to understand the solution would be writing it like this:
Dim wb as Workbook: set wb = ThisWorkbook
Dim conns as Connections: set conns = wb.Connections
conns(conns.Count).Delete
Note: I'm also assuming this macro will only operate on the workbook it lives in; I noticed your code uses the workbook pointer ActiveWorksheet so using ActiveWorkbook or whatever the workbook equivalent is might be more relevant in your use case.
Hope this helps!

How to read from a text (.txt) file and place data into an excel 2016 document using VBA Macros editor?

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

Importing multiple CSV to multiple worksheet in a single workbook

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