使用VBA导入和重命名.CSV文件

Question

我正在研究一个宏，对三个工作簿进行重新格式化和编辑。这三本工作手册的名称始终相同，并且来自同一个来源。他们以.csv格式到达。我想让VBA将所有这三个工作簿作为单独的工作表导入到一本书中，并根据每个工作簿的标题中找到的字符串重命名这些工作表。有没有简单的方法将它附加到录制的宏？此外，是否有更好的方式导入和分隔/格式化文件，而不是通过记录宏生成的方式？我已经把代码从下面这个方法：

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

我提出以下为打开CSV并在将其添加到输出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