Combine multiple CSV files automatically instead of using Application.GetOpenFilename

[davidp13]

Hi. I have a piece of code that helps me select multiple CSV files and then import them into one sheet where I will then run additional scripts to build output data. I'm looking to automate the process more and trying to circumvent the selection of the CSV through the manual process and rather have the script automatically pick up all the files and then import + manipulate as needed.

Below is the code. Can anyone help me change this so that when I execute it, it will choose all the CSV in a folder automatically? Thanks

Sub Import()    Dim fn, ws As Worksheet, e, flg As Boolean, LastR As Range, wsName As String
   
    fn = Application.GetOpenFilename("Excel(*.csv*),*.csv*", MultiSelect:=True)
    
    If Not IsArray(fn) Then Exit Sub
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Application.ScreenUpdating = False
    ws.Cells.Clear
    For Each e In fn
        With Workbooks.Open(e)
            With .Sheets(1)
                wsName = .Name
                If Not flg Then
                    .Rows(1).Copy ws.Cells(1)
                    ws.Columns(1).Insert
                    ws.Cells(19).Value = "Sheet name"
                    flg = True
                End If
                Set LastR = ws.Cells(Rows.Count, 2).End(xlUp)(2)
                With .Range("a1").CurrentRegion
                    With .Resize(.Rows.Count - 1).Offset(1)
                        .Copy LastR
                        LastR(, 18).Resize(.Rows.Count).Value = _
                            CreateObject("Scripting.FileSystemObject").GetBasename(e)
                    End With
                End With
            End With
            .Close False
        End With
    Next
    Sheets("Sheet1").Range("A:A").EntireColumn.Delete
    ws.Range("a1").CurrentRegion.Columns.AutoFit
    Application.ScreenUpdating = True
    Set ws = Nothing
End Sub

 

[Joe4]

See the methodology used here: https://www.mrexcel.com/forum/excel-questions/404849-loop-through-folder-csv-files-import-save.html

 

[davidp13]

Thanks for the response.
I found the following thread that helped, but now I need to figure out how to copy the file name into the sheet.
https://www.mrexcel.com/forum/excel...e-all-new-csvs-folder-into-one-worksheet.html

 

[Joe4]

Post your current code, and we will see if we can help you add that piece in.

 

[davidp13]

Thanks Joe4. Below is the code I have now and I only need the add the CSV filename on each row.

Option Explicit

Sub ImportCSV()


    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Application.ScreenUpdating = False
    ws.Cells.Clear
    
    'Change the path to the source folder accordingly
    strSourcePath = "C:\Users\admi n\Google Drive\Everest\Daily Scans - Portfolio_v2\"
    
    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
    
    'Change the path to the destination folder accordingly
    strDestPath = "C:\Users\admi n\Google Drive\Everest\Daily Scans - Portfolio_v2\"
    
    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
    
    strFile = Dir(strSourcePath & "*.csv")
    
    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        If Cnt = 1 Then
            r = 1
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Open strSourcePath & strFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            If Cnt > 1 Then
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , strData
                
            End If
            Do Until EOF(1)
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , strData
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    Cells(r, c + 1).Value = Trim(x(c))
                    ws.Cells(18).Value = "Sheet name"
                Next c
                r = r + 1
            Loop
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation
    
End Sub

 

[Joe4]

See if changing this file:

ws.Cells(18).Value = "Sheet name"

to this:

ws.Cells(r,18).Value = strFile

does what you want.

 

[davidp13]

Thanks a mil again for your help it is really appreciated. The code below is what worked.

ws.Cells(r, 18).Value = CreateObject("Scripting.FileSystemObject").GetBasename(strFile)

 

[Joe4]

You are welcome.

I am curious, did the solution I provided with just using "strFile" not work for you?
It did for me in testing?
If it does, it may be a little more efficient than creating another object.

 

[davidp13]

It copies the .csv part of the filename as well and I only want the name excluding the suffix. the object way is a bit slower so i'm open to any suggestions it more efficient. Thanks

 

[Joe4]

This will do it:

ws.Cells(r,18).Value = Left(strFile,Len(strFile)-4)