I have a ton of .csv documents that are identical in their setup. They are all .csv and therefore all need simple formatting. My goal is quite simply to:

1. Format them from .csv to regular columns (e.g., TextToColumns in Excel)
2. Extract data from each separate file into one Excel sheet for further analysis

I have tried many things in VBA to loop through a folder with a macro, but I have not succeeded yet. In fact, none of the macros have done any changes whatsoever(?) I hope someone can help. One of my attempts is shown below.

Best, Karl

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

Edit:
OPs Eureka! code from comments:

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

CodePudding user response：

If you need to import csv files in to Excel ranges, use some Sub like the one below in "Do While.." loop instead of "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

CodePudding user response：

Import From 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