Nhập nhiều CSV vào nhiều trang tính trong một sổ làm việc

Question

Làm cách nào để thực hiện việc này? Về cơ bản tôi muốn nhiều tệp CSV của tôi được nhập vào nhiều trang tính nhưng chỉ trong một sổ làm việc. Đây là mã VBA của tôi mà tôi muốn lặp lại. Tôi cần vòng lặp để truy vấn tất cả các CSV trong 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

tôi không thử loại này, nhưng tôi muốn đi với 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

Hãy coi chừng, điều này không xử lý các lỗi như bạn sẽ có tên trang tính trùng lặp nếu bạn đã nhập csv.

này sử dụng đầu ràng buộc, do đó bạn cần phải tham khảo Microsoft.Scripting.Runtime dưới Tools..References trong 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

Bạn có thể sử dụng Dir để lọc ra và chạy chỉ với csv file

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 hoàn toàn đóng đinh nó. Rất ngắn gọn mã và hoạt động hoàn hảo cho tôi vào năm 2010. Tất cả các tín dụng đi với anh ta (Jerry Beaucaire). Tôi tìm thấy nó từ một diễn đàn 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