VBA add rows from filename into cells

Question

I did research on stack but unable to find exactly what I need or close enough to edit the code. I am pretty new to VBA.

I have bunch (> 100 files) of .csv files in a directory. The file name is consistent with this format: customer_id-inventory_id.forecast.csv.

For example: 12345678-111111.forecast.csv; 12345-222.forecast.csv; ...etc

These files have only two columns with date and forecast. I want to bring in customer_id and inventory_id from the filename into these cells for each file. Please see the original file:

12345678-111111.forecast.csv;

12345-222.forecast.csv;

Output file after bringing in the customer_id and inventory_d. How do I write this in VBA? Thanks!

12345678-111111.forecast.csv;

12345-222.forecast.csv;

I tried: VBA - Excel Append Every Active Row With File Name

Dim LastRow As Long
Dim LastColumn As Long
Sub InsertFileName()
  Application.ScreenUpdating = False
  Dim i As Long
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  For i = 1 To LastRow
    LastColumn = ActiveSheet.Cells(i,     ActiveSheet.Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(i, LastColumn + 1) = "=CELL(""filename"")"
  Next i
  Application.ScreenUpdating = True
End Sub

This is not generating any file names.

You want to do it automatically for all the csvs right? Or you only want to run that macro on a subset of the files? Btw, it will be always the `C` and `D` columns which will handle the filename information? — RCaetano, Oct 27 '16 at 14:13
@RCaetano. Yes, want it automatically pick up the .csv filenames into respective file. I am running macro/vba as well. — sharp, Oct 27 '16 at 14:15
@RCaetano Yes, it will be C and D only. All the file content formats are the same. — sharp, Oct 27 '16 at 14:23
Did any of the presented solutions worked for you or do you need more help? — RCaetano, Oct 28 '16 at 08:32
@Rcaetano Not sure yet. I am running the test, but I keep getting errors so trying to fix that. — sharp, Oct 28 '16 at 13:39
Is my code giving you errors? Can you tell me which ones and where they occurr please so I can fix it? — RCaetano, Oct 28 '16 at 13:48
@RCaetano Nope. There seems to be lot of errors and I am very new to VBA to fix those. I just merged the files through R itself. Thanks for everyone help!! Really appreciate it. — sharp, Nov 02 '16 at 12:29

score 0 · Answer 1 · answered Oct 27 '16 at 14:56

This assumes the workbook is in the same directory as all CSVs.

Sub Consolidate()

    Dim sSQL        As String       'SQL String
    Dim oCn         As Object       'Connection
    Dim oRs         As Object       'Recordset
    Dim vFile       As Variant      'File Name
    Dim sCustomer   As String       'Customer ID
    Dim sItem       As String       'Inventory Item ID

'   Get filenames
    vFile = Dir(ThisWorkbook.Path & "\*.csv")

'   Create SQL
    While vFile <> vbNullString
        If sSQL <> vbNullString Then sSQL = sSQL & vbCr & "Union " & vbCr
        sCustomer = Split(vFile, "-")(0)
        sItem = Split(Split(vFile, "-")(1), ".")(0)
        sSQL = sSQL & "Select '" & sCustomer & "' as Customer, '" & sItem & "' as Item, * from [" & vFile & "]"
        vFile = Dir
        DoEvents
    Wend
'   Create Connection Objects
    Set oCn = CreateObject("ADODB.Connection")
    Set oRs = CreateObject("ADODB.Recordset")

    oCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & ThisWorkbook.Path & ";" & _
            "Extended Properties=""Text;HDR=YES;FMT = CSVDelimited"";"
    oRs.Open sSQL, oCn
    Debug.Print sSQL

    If Sheet1.ListObjects.Count > 0 Then Sheet1.ListObjects(1).Delete
    Sheet1.ListObjects.Add( _
        SourceType:=xlSrcQuery, _
        Source:=oRs, _
        Destination:=Sheet1.Range("C6")).QueryTable.Refresh

    oRs.Close
    oCn.Close

    Set oRs = Nothing
    Set oCn = Nothing

End Sub

Thanks!!!! Trying to run this but getting errors like : run time error '-2147467259 (80004005) automation error unspecified error. Ran ODBC drivers must match the 32 didn't help. Working on to fix the automation error. — sharp, Oct 27 '16 at 15:16
This may help: See: http://stackoverflow.com/questions/13811179/where-how-can-i-download-and-install-the-microsoft-jet-oledb-4-0-for-windows-8 — Craig Hatmaker, Oct 27 '16 at 17:40
That error seems to be that the workbook you are attempting to run it from has not been saved. Make sure to save it into the directory where the CSVs are. — Craig Hatmaker, Oct 27 '16 at 17:43

score 0 · Answer 2 · answered Oct 27 '16 at 15:33

NOTE: Before running this macro you should create a backup of your csv files in case something go wrong. Then maybe this code can help you:

Option Explicit

Sub LoopCsvFiles()

    Dim wb As Workbook
    Dim ws_name As String
    Dim file As Variant
    Dim aux_var As Variant

    ' Disabling alerts and screen updates
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' csv_folder that contains your csv files 
    file = Dir("C:\csv_folder\")
    While (file <> "")
        If InStr(file, ".csv") > 0 Then

            ' Obtaining the first part of the filename
            aux_var = Split(file, ".")
            ' Obtaining the customer_id and the inventory_id
            aux_var = Split(aux_var(0), "-")

            ' Setting the workbook and sheetname
            Set wb = Workbooks.Open(file)
            ws_name = Replace(file, ".csv", "")

            ' Writting data
            wb.Worksheets(ws_name).Range("C1") = "customer_id"
            wb.Worksheets(ws_name).Range("C2") = aux_var(0)
            wb.Worksheets(ws_name).Range("D1") = "inventory_id"
            wb.Worksheets(ws_name).Range("D2") = aux_var(1)

            ' Exiting
            wb.Save
            wb.Close

        End If
        file = Dir
    Wend

    ' Restoring alerts and screen updates
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done!"

End Sub

HTH ;)

VBA add rows from filename into cells

2 Answers2