Vba 将多个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

---

我没有试过这个，但我会选择：

---

注意，这不会像导入

csv

时会有重复的图纸名称那样处理错误

这使用早期绑定，因此您需要在工具..中引用

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

---

您可以使用

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

子宏循环（）
作为字符串的Dim strFile
将ws设置为工作表
strFile=Dir（“c:\test\*.csv”）
执行While strFile vbNullString
设置ws=Sheets.Add
使用ws.QueryTables.Add（连接：=_
“TEXT；”和“C:\test\”&strFile，目标：=范围（$A$1））
.Name=strFile
.FieldNames=True
.rowNumber=False
.FillAdjacentFormulas=False
.PreserveFormatting=True
.refreshinfoleopen=False
.RefreshStyle=xlInsertDeleteCells
.SavePassword=False
.SaveData=True
.AdjustColumnWidth=True
.RefreshPeriod=0
.TextFilePromptOnRefresh=False
.TextFilePlatform=437
.TextFileStartRow=1
.TextFileParseType=xlDelimited
.TextFileTextQualifier=xlTextQualifierDoubleQuote
.textfileconsutivedelimiter=False
.TextFileTabDelimiter=False
.TextFileSemicolonDelimiter=False
.textfilecommadelimitor=True
.TextFileSpaceDelimiter=False
.TextFileColumnDataTypes=数组（1,1,1,1,1）
.TextFileTrailingMinusNumbers=True
.Refresh BackgroundQuery:=False
以
strFile=Dir
环
端接头

绝对正确。非常简洁的代码，在2010年非常适合我。所有的荣誉都归于他（杰里·博凯尔）。我在论坛上找到的

---

我有183个csv文件要压缩成一个工作簿，每个csv文件一个工作表以便于数据分析，我不想一次手动完成一个。我在这个问题上尝试了最高评分的解决方案，但与另一个用户有相同的问题；csv文件将打开，但不会向目标工作簿插入任何内容。我花了一些时间调整了代码，使其与Excel 2016中的一样工作。我没有在旧版本上测试过。我已经很久没有用Visual Basic编写代码了，所以我的代码可能还有很多改进的空间，但它在紧要关头对我起了作用。万一有人像我一样偶然发现这个问题，我将粘贴下面使用的代码

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
'Update: base script as seen in: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/merge-functions/csvs-to-sheets
'Update: adjusted code to work in Excel 2016

Dim fPath   As String
Dim fCSV    As String
Dim wbName  As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook


wbName = "this is a string"
Set wbMST = ThisWorkbook

fPath = "C:\pathOfCSVFiles\"                  '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
        If wbName = "this is a string" Then 'this is to check if we are just starting out and target workbook only has default Sheet 1
            wbCSV.Sheets.Copy After:=wbMST.Sheets(1) 'for first pass, can leave as is. if loading a large number of csv files and excel crashes midway, update this to the last csv that was loaded to the target workbook
        Else
            wbCSV.Sheets.Copy After:=wbMST.Sheets(wbName) 'if not first pass, then insert csv after last one
        End If

        fCSV = Dir                  'ready next CSV
        wbName = ActiveSheet.Name 'save name of csv loaded in this pass, to be used in the next pass
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub

---

Application.FileSearch

在Office 2007中被弃用，因此这不太合适工作表名称不反映此代码的CSV文件名。如何解析？我已经解析了工作表的文件名。我的新问题是，我的内存出错了。我正在导入大约80个CSV文件。@Dumont关于文件名，我想你会看到我使用了一个变量。在你的内存错误上，它导入了多少CSV？如果您接受的另一个代码使用相同的导入方法（但先测试每种文件类型），那么它是否工作？是的，它给出了相同的错误。我正在导入大约80个CSV文件。现在没事了。当CSV没有内容时，代码似乎会失败。我刚刚在错误恢复下一步时添加了

，

这似乎对2013不起作用（除非我遗漏了什么）。我将此脚本复制到一个启用宏的Excel工作簿（2013）中，并运行了它（在指定目录中有两个.csv文件）。当我运行它时，它打开了两个新的Excel实例（两个新工作簿），每个实例中只有一个工作表，而我的原始工作簿中没有任何内容。脚本需要更新吗？对不起，我可能没有时间调查。欢迎提供最新答案。

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

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
'Update: base script as seen in: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/merge-functions/csvs-to-sheets
'Update: adjusted code to work in Excel 2016

Dim fPath   As String
Dim fCSV    As String
Dim wbName  As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook


wbName = "this is a string"
Set wbMST = ThisWorkbook

fPath = "C:\pathOfCSVFiles\"                  '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
        If wbName = "this is a string" Then 'this is to check if we are just starting out and target workbook only has default Sheet 1
            wbCSV.Sheets.Copy After:=wbMST.Sheets(1) 'for first pass, can leave as is. if loading a large number of csv files and excel crashes midway, update this to the last csv that was loaded to the target workbook
        Else
            wbCSV.Sheets.Copy After:=wbMST.Sheets(wbName) 'if not first pass, then insert csv after last one
        End If

        fCSV = Dir                  'ready next CSV
        wbName = ActiveSheet.Name 'save name of csv loaded in this pass, to be used in the next pass
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub