하나의 통합 문서에서 여러 워크 시트로 여러 CSV 가져 오기

Question

어떻게해야합니까? 기본적으로 여러 CSV 파일을 여러 워크 시트로 가져 오지만 하나의 통합 문서에서만 가져오고 싶습니다. 다음은 루프하려는 VBA 코드입니다. 나는이 시도하지 않았다 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

에 CSV를 쿼리 모두에 루프 필요하지만, 내가 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을 참조하는 데 필요한 당신은 필터링 그냥 csv 파일을 실행 Dir을 사용할 수 있습니다 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

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