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
LVL 1
LD16Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
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

LD16Author Commented:
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
2015-07-30-00-37-38-Microsoft-Excel-non-Ex:Open manually
2015-07-30-00-38-17-Microsoft-Excel-non-
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)
2015-07-30-00-47-58-Microsoft-Visual-Bas
Thank you very much for your help.
LD16Author Commented:
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.
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

LD16Author Commented:
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 HedegaardCommented:
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
LD16Author Commented:
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 HedegaardCommented:
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.
LD16Author Commented:
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:

2015-07-31-19-41-14-Microsoft-Excel---Re
Ejgil HedegaardCommented:
Program updated
Result-1.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Fantastic!!!!! Thank you very much for your help!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.