VBA to insert filename in a new column for all files in a folder

[psion2600]

Hi all. I have a situation where multiple .csv files with the same output format are exported to a specific folder. It can be several on a day or hundreds. Each file has a maximum range of date from A1 to F97. Always from A to F but sometime fewer than 97 row entries. I would like to insert a new column (RACK_BC) in column G only for rows containing data. The inserted column cells should have the formula "=right(cell=("filename"),31)". After the column addition, the file can either be renamed from "*.csv" to "*edited.csv" or exported to a new subfolder "edited" with the same filename. Output file should look like the image below. Thank you for the help.

 

[John_w]

So basically you want to append the .csv file name to each line as a new column.

This allows you to browse for the folder containing the .csv files and saves the modified files in the 'edited' subfolder of the selected folder.

Public Sub Modify_CSV_Files()

    Dim FSO As Object 'Scripting.FileSystemObject
    Dim FStext As Object 'Scripting.TextStream
    Dim FSfile As Object 'Scripting.File
    Dim csvFolder As String, outputFolder As String
    Dim csvLines As Variant, i As Long
        
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select folder containing .csv files"
        If Not .Show Then Exit Sub
        csvFolder = .SelectedItems(1)
    End With
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    outputFolder = FSO.BuildPath(csvFolder, "edited\")
    If Not FSO.FolderExists(outputFolder) Then FSO.CreateFolder outputFolder
    
    For Each FSfile In FSO.GetFolder(csvFolder).Files
        If LCase(FSfile.Name) Like "*.csv" Then
            Set FStext = FSO.OpenTextFile(FSfile.Path)
            csvLines = Split(FStext.ReadAll, vbCrLf)
            FStext.Close
            csvLines(0) = csvLines(0) & ",Rack_BC"
            For i = 1 To UBound(csvLines) - 1
                If Join(Split(csvLines(i), ","), "") <> "" Then
                    csvLines(i) = csvLines(i) & "," & FSfile.Name
                End If
            Next
            Set FStext = FSO.CreateTextFile(outputFolder & FSfile.Name)
            FStext.Write Join(csvLines, vbCrLf)
            FStext.Close
        End If
    Next
    
    MsgBox "Done"
    
End Sub

 

[psion2600]

So basically you want to append the .csv file name to each line as a new column.

This allows you to browse for the folder containing the .csv files and saves the modified files in the 'edited' subfolder of the selected folder.

Public Sub Modify_CSV_Files()

    Dim FSO As Object 'Scripting.FileSystemObject
    Dim FStext As Object 'Scripting.TextStream
    Dim FSfile As Object 'Scripting.File
    Dim csvFolder As String, outputFolder As String
    Dim csvLines As Variant, i As Long
       
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select folder containing .csv files"
        If Not .Show Then Exit Sub
        csvFolder = .SelectedItems(1)
    End With
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    outputFolder = FSO.BuildPath(csvFolder, "edited\")
    If Not FSO.FolderExists(outputFolder) Then FSO.CreateFolder outputFolder
   
    For Each FSfile In FSO.GetFolder(csvFolder).Files
        If LCase(FSfile.Name) Like "*.csv" Then
            Set FStext = FSO.OpenTextFile(FSfile.Path)
            csvLines = Split(FStext.ReadAll, vbCrLf)
            FStext.Close
            csvLines(0) = csvLines(0) & ",Rack_BC"
            For i = 1 To UBound(csvLines) - 1
                If Join(Split(csvLines(i), ","), "") <> "" Then
                    csvLines(i) = csvLines(i) & "," & FSfile.Name
                End If
            Next
            Set FStext = FSO.CreateTextFile(outputFolder & FSfile.Name)
            FStext.Write Join(csvLines, vbCrLf)
            FStext.Close
        End If
    Next
   
    MsgBox "Done"
   
End Sub

John,
Thank you for the response to the problem. I tested the code several times as the first instance did not work. I quickly realized it was just an ID10T error on my part as the delimiters are semicolons in my worksheets instead of commas as you wrote the code. Made a couple updates for that and it works like a charm. Thank you very much!