Using Excel VBA to loop through .csv files in folder and copy the filename into cells in last column

Question

I have thousands of .csv files with specific file names. Each .csv files have the 1st row as header, and the following rows (usually 20 rows) as data. I need help in copying the filename of each .csv file into the last column for 20 rows, and would need to cycle through all the .csv files in the folder.

Thanks in advance!

Answer 1

This should do it. Depending on what your doing you may want to alter it so it wont add the filename field if it already exists. etc.

Public Sub UpdateFiles()

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim xl As New Excel.Application
    Dim wb As New Excel.Workbook
    Dim lastRow
    Dim lastColumn

    Dim folder

    'Change this folder to the one you want.
    Set folder = fso.getFolder("c:\notbackedup\")

    'Uncomment to watch/debug code
    'xl.Visible = True

    For Each f In folder.Files
        Debug.Print f.Name
        If (f.Name Like "*.csv") Then
            Set wb = xl.Workbooks.Open(f.Path)
            lastRow = wb.Sheets(1).UsedRange.Rows.Count
            lastColumn = wb.Sheets(1).UsedRange.Columns.Count
            wb.Sheets(1).Range(ColumnLetter(lastColumn + 1) & "1").Value = "FileName"
            wb.Sheets(1).Range(ColumnLetter(lastColumn + 1) & "2:" & ColumnLetter(lastColumn+1) & lastRow).Value = f.Name
            wb.Save
            wb.Close True
        End If
    Next
    xl.Quit


End Sub
Function ColumnLetter(ByVal ColumnNumber As Long) As String
    Dim n As Long
    Dim c As Byte
    Dim s As String

    n = ColumnNumber
    Do
        c = ((n - 1) Mod 26)
        s = Chr(c + 65) & s
        n = (n - c) \ 26
    Loop While n > 0
    ColumnLetter = s
End Function