将多个CSV导入到单个工作簿中的多个工作表

我该怎么做呢？ 基本上我想我的多个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

这家伙绝对钉了它。 非常简洁的代码，在2010年完美地为我工作。所有功劳都归功于他（Jerry Beaucaire）。 我在这里find了一个论坛。

 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 

Answer 2

请注意，这不会处理错误，如果您导入了csv您将拥有重复的工作表名称。

这使用早期绑定，所以你需要在VBE Tools..References下引用Microsoft.Scripting.Runtime

 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

我没有尝试这个，但我会去这个 ：

 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