17

我该怎么做呢？基本上我希望我的多个 CSV 文件被导入到多个工作表中，但只在一个工作簿中。这是我要循环的 VBA 代码。我需要循环来查询所有 CSVC:\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
4

5 回答 5

19

这家伙绝对算了。非常简洁的代码，在 2010 年非常适合我。所有功劳都归功于他（Jerry Beaucaire）。我从这里的一个论坛找到它。

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
于 2015-11-03T11:57:36.827 回答
6

请注意，这不会处理错误，例如如果您导入csv.

这使用早期绑定，因此您需要Microsoft.Scripting.Runtime在Tools..References下的ReferenceVBE

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
于 2012-08-28T15:45:41.480 回答
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
于 2012-08-28T23:04:44.490 回答
2

我有 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
于 2019-05-08T20:56:12.030 回答
0

我没有尝试过，但我会这样做：

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
于 2012-08-28T15:43:33.837 回答