將多個CSV導入到單個工作簿中的多個工作表中

Question

如何執行此操作？基本上我想我的多個CSV文件被導入到多個工作表，但只在一個工作簿中。這是我想循環的VBA代碼。我需要循環到所有查詢CSV在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 

Answer 1

我沒有嘗試這一點，但我會用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 

Answer 2

當心，這並不像處理錯誤，你會如果您導入csv，則具有重複的工作表名稱。

這使用早期綁定，所以你需要先參考Microsoft.Scripting.Runtime下Tools..References的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 

Answer 3

您可以使用Dir過濾掉，並只用csv文件運行

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 

Answer 4

This guy絕對釘牢它。非常簡潔的代碼，在2010年完全適合我。所有功勞都歸他所有（Jerry Beaucaire）。我從論壇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