एक वर्कबुक में एकाधिक वर्कशीट में एकाधिक सीएसवी आयात करना

Question

मैं यह कैसे कर सकता हूं? असल में मैं चाहता हूं कि मेरी कई सीएसवी फाइलें एकाधिक वर्कशीट में आयात की जाएंगी लेकिन केवल एक ही कार्यपुस्तिका में। यहां मेरा वीबीए कोड है जिसे मैं लूप करना चाहता हूं। मैं पाश की जरूरत है सभी 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 आयात किया है तो एक डुप्लिकेट शीट नाम रखें।

इस प्रारंभिक बंधन का उपयोग करता है, ताकि आप में Tools..References Microsoft.Scripting.Runtimeतहत संदर्भित करने के लिए जरूरत 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 में मेरे लिए पूरी तरह से काम करता है। सभी क्रेडिट उसके पास जाते हैं (जेरी 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