使用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