Importing and Renaming .CSV Files Using VBA

Question

I am working on a macro to do some reformatting and editing of three workbooks. These three workbooks always have the same names, respectively, and come from the same source. They arrive in .csv format. What I would like is for VBA to import all three of these workbooks to one book as separate sheets, and rename these sheets based on a string found in the title of each workbook. Is there an easy way to append this to a recorded macro? Moreover, is there a better way of importing and delimiting / formatting the file than the way generated by recording a macro? I have placed the code from this method below:

With ActiveSheet.QueryTables.Add(Connection:= _
    "FAKENAME.csv" _
    , Destination:=Range("$A$1"))
    .CommandType = 0
    .Name = "FAKENAME"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 65001
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, _
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

Answer 1

I propose the following as a much easier method for opening CSVs and adding them to an output Workbook:

Option Explicit
Sub ImportCSVsToSheets()

Dim File As String, Path As String
Dim CSV As Workbook, Book As Workbook
Dim CS As Worksheet, Sheet As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Source As Range, Target As Range

'set references up-front
Application.DisplayAlerts = False
Path = "c:\my\csv\files\"
File = Dir(Path & "*.csv")
Set Book = Workbooks.Add

'output workbook setup, make it bare-bones by deleting all non-first sheets
For Each Sheet In Book.Worksheets
    If Sheet.Index <> 1 Then
        Sheet.Delete
    End If
Next Sheet
Set Sheet = Book.Worksheets(1)
Sheet.Name = "DeleteMeSoon"

'loop through the CSVs and write data to sheets in output book
Do While Len(File) > 0
    'set up CSV and determine copy range
    Set CSV = Workbooks.Open(Path & File)
    Set CS = CSV.ActiveSheet
    With CS
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Set Source = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
    End With

    'set up new sheet and destination range
    Set Sheet = Book.Worksheets.Add
    With Sheet
        Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
    End With

    'copy data from CSV to target
    Source.Copy Target

    'set the sheet name using the CSV file name
    Sheet.Name = Left(Left(File, Len(File) - 4), 31)

    'close the CSV and repeat
    CSV.Close SaveChanges:=False
    File = Dir
Loop

'remove that last pesky sheet
Set Sheet = Book.Worksheets("DeleteMeSoon")
Sheet.Delete

'save it however you'd like and boom we're done
'Book.SaveAs Filname:="a-file-name", FileFormat:=xlWhatever
Application.DisplayAlerts = True
End Sub