asked on

VBA: import csv files into a single xlsm files.

Hello experts, I have in a folder csv files (files attached).

All of the files have the same number of columns and same header.

I would like to run a macro through a xlsm file and do the following
1-Enter in column A the csv file names of each file imported
2-Import one time the header and bellow all the data of each csv file into one single file as of column B as column A is reserved for the csv file name

Please see attached the result.xlsm and the reference csv files.

In my example I put just 2 files but the idea is that the macro loops the various files located in the reported folder.

Thank you very much for your help.
SESA106617-1.csv
SESA162088-1.csv
Result.xlsm

Patrick Matthews

This seems to be working.

Sub GetData()
    
    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    Dim SourceWb As Workbook
    Dim SourceWs As Worksheet
    Dim WbWasOpen As Boolean
    Dim DestWs As Worksheet
    Dim FileCounter As Long
    Dim SourceLastR As Long
    Dim DestLastR As Long
    Dim SourceLastC As Long
    
    Const SourceDir As String = "C:\Data" 'change to reflect directory with CSV files
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(SourceDir)
    Set DestWs = ThisWorkbook.Worksheets("Result")
    DestWs.Rows.Delete
    
    For Each fil In fld.Files
        FileCounter = FileCounter + 1
        On Error Resume Next
        Set SourceWb = Workbooks(fil.Name)
        If Err <> 0 Then
            Set SourceWb = Workbooks.Open(fil.Path)
            WbWasOpen = False
            Err.Clear
        Else
            WbWasOpen = True
        End If
        On Error GoTo 0
        Set SourceWs = SourceWb.Worksheets(1)
        SourceLastR = SourceWs.Cells(SourceWs.Rows.Count, 1).End(xlUp).Row
        If LCase(fil.Name) Like "*.csv" Then
            If FileCounter = 1 Then
                DestWs.Cells(1, 1) = "CSV name"
                SourceLastC = SourceWs.Cells(1, SourceWs.Columns.Count).End(xlToLeft).Column
                SourceWs.Cells(1, 1).Resize(SourceLastR, SourceLastC).Copy DestWs.Cells(1, 2)
                DestWs.Cells(2, 1).Resize(SourceLastR - 1, 1) = fil.Name
            Else
                DestLastR = DestWs.Cells(DestWs.Rows.Count, 1).End(xlUp).Row
                SourceWs.Cells(2, 1).Resize(SourceLastR - 1, SourceLastC).Copy DestWs.Cells(DestLastR + 1, 2)
                DestWs.Cells(DestLastR + 1, 1).Resize(SourceLastR - 1, 1) = fil.Name
            End If
            If Not WbWasOpen Then SourceWb.Close False
        End If
    Next
    
    Set fil = Nothing
    Set fld = Nothing
    Set fso = Nothing
    
    DestWs.Columns.AutoFit
    
    MsgBox "Done"
    
End Sub

Open in new window

Luis Diaz

ASKER

Thank you for this code.
I have a couple of remarks:
1-Is there a way to turn off all the message when a csv file is opened?
2-I don't know why the macro open the csv files without taking into account the ; as a delimiter:

Ex:Open with the macro

Ex:Open manually

As a result when I launch the macro it's open the first file and then I have a error message related to line
SourceWs.Cells(2, 1).Resize(SourceLastR - 1, SourceLastC).Copy DestWs.Cells(DestLastR + 1, 2)

Thank you very much for your help.

Luis Diaz

ASKER

An idea to import properly the csv file is to use a function as the file is imported when you Use the Data->Import from text a function like this:

Function Import_CSV(xFile) As String
' Unfortunately, for dd/mm/yyy users, Excel messes up dates when _programatically_ opening a CSV file.
' So we use the Wizard and specifically set the date to "dd/mm/yyyy". <Sigh>
Dim xBook As Workbook

Set xBook = Workbooks.Add

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\" & xFile, Destination:=Range("$A$1"))
    .Name = xFile
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(4)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

Import_CSV = xBook.Name

End Function

Open in new window

And then call the function when needed.

Luis Diaz

ASKER

I tried to record the macro of my first import file and this is how I get:

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;\\psf\\Files\Import-csv-files\SESA106617-1.csv" _
        , Destination:=Range("$A$1"))
        .Name = "SESA106617-1"
        .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 = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

Open in new window

Ejgil Hedegaard

Try attached file.
Put the file in the same folder as the csv files, and press the button on sheet Result to run the macro.
Result-1.xlsm

Luis Diaz

ASKER

It works thank you very much, excellent VBA Code and also thank you very much for the form progress bar.

I have a question it will not be interesting to set the Range of used Range of each variable so If I want to reuse the code I need to change the variable and also to check if the directory is not empty except of the file which contains the macro?

I forgot to add in my specs to make a sum from J to AO do you know how can add this to the code?

Thank you again for your help!

Ejgil Hedegaard

What do you mean by

set the Range of used Range of each variable

What do you want to happen when there are no data files?
Keep existing result, or?
As it is, all that happens is that the existing data on the Result sheet are removed.
Should the data files be in a different folder than the program file?

Do you mean a sum for each column J to AO after the last row of imported data, a formula or just the result?
Or a total sum for all columns?

Please specify.

Luis Diaz

ASKER

1-Forgot my first question I made a mistake

2-If the folder is empty then exit the sub and don't create Result sheet.
2-I meant total sum of each row like this:

ASKER CERTIFIED SOLUTION

Ejgil Hedegaard

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Fantastic!!!!! Thank you very much for your help!