对文件夹中的所有文件执行 VBA 宏

Question

我有大量设置相同的 .csv 文档。它们都是 .csv，因此都需要简单的格式。我的目标很简单：

1. 将它们从 .csv 格式化为常规列（例如，Excel 中的 TextToColumns）
2. 将每个单独文件中的数据提取到一个 Excel 工作表中以供进一步分析

我在 VBA 中尝试了很多方法来循环使用宏的文件夹，但我还没有成功。事实上，没有一个宏做任何改变（？） 我希望有人能帮帮忙。我的尝试之一如下所示。

最好， 卡尔

Dim filename As Variant
Dim a As Integer
a = 1

filename = Dir("/Users/karlemilthulstrup/Downloads/Test med kun 1Vp/Files*.csv")

Do While filename <> ""
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
        DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:= _
        True

Loop

End Sub

编辑：
OPs Eureka! 来自 cmets 的代码：

Sub test6()
    Dim filename As Variant
    Dim a As Integer
    Dim MyFiles As String
    a = 1
    filename = Dir("/Users/karlemilthulstrup/Downloads/Test med kun 1Vp/Files.csv")
    Do While filename <> ""
        Workbooks.Open MyFiles
        ActiveWorkbook.Close SaveChanges:=True
        filename = Dir
    Loop
End Sub

Answer 1

如果您需要将 csv 文件导入 Excel 范围，请在“Do While..”循环中使用如下所示的 Sub 而不是“Workbook.Open”

'' transfer a csv file data to Excel at start of Cell range specified
Public Sub ImportCSV2Excel(csvFilePath As String, atCell As Range)
    Dim Fso As Object, txtFile As Object
    Dim LineTxt As Variant, i As Long
    Set Fso = VBA.CreateObject("Scripting.FileSystemObject")

    Set txtFile = Fso.OpenTextFile(Filename:=csvFilePath, IOMode:=1, Create:=False) ''IOMode Enum (ForReading=1, ForWriting=2, ForAppending=8)
    atCell.CurrentRegion.Clear
    While Not txtFile.atEndofstream
        LineTxt = VBA.Split(txtFile.readline, ",")
        i = i + 1
        atCell.Cells(i, 1).Resize(1, UBound(LineTxt) + 1).Value = LineTxt
    Wend
    txtFile.Close
    Set txtFile = Nothing

End Sub

Sub test_Importcsv()
    ImportCSV2Excel "E:/sales.csv", Sheet1.Range("A1")
End Sub

Answer 2

从CSV 导入

Option Explicit

Sub ImportData()
    Const ProcTitle As String = "Import Data"
    
    Const sSubPath As String = "/Downloads/Test med kun 1Vp/Files/"
    Const sFilePattern As String = "*.csv"
    
    Dim sPath As String: sPath = Environ("USERPROFILE") & sSubPath
    
    Dim sfName As String: sfName = Dir(sPath & sFilePattern)
    If Len(fName) = 0 Then
        MsgBox "No files found in '" & sPath & "'.", vbCritical, ProcTitle
        Exit Sub
    End If
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    
    'Application.ScreenUpdating = False ' uncomment when you got it right
    
    Do Until Len(sfName) = 0
        Dim swb As Workbook
        Set swb = Workbooks.Open(Filename:=sPath & sfName)
        ' When opening the workbook there are many parameters you can use.
        ' When a 'csv' opens with all the data in one column, I most often
        ' just need to set the `Local` argument to `True` i.e.:
        'Set swb = Workbooks.Open(Filename:=sPath & sfName, Local:=True)
        ' Note that there is also the 'Delimiter' argument which you could
        ' modify to get the workbook open 'properly'. Also, there is
        ' the 'Workbooks.OpenText method'. Using `TextToColumns` should be
        ' your last 'resort'.
        Dim sws As Worksheet: Set sws = swb.Worksheets(1) ' only one per 'csv'
        sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        swb.Close SaveChanges:=False
        sfName = Dir
    Loop
    
    'dwb.save
    
    'Application.ScreenUpdating = True ' uncomment when you got it right
    
    MsgBox "Data imported.", vbInformation, ProcTitle
        
End Sub