Search code examples
vbacsvfilesystemobject

reading and writing a csv file using FileSystemObject


Is it possible to read and write csv files using FileSystemObject in VBA?


Solution

  • It certainly is.

    Basic syntax such as

        Set objFSO = CreateObject("scripting.filesystemobject")
        'create a csv file
        Set objTF = objFSO.createtextfile("C:\test\myfile.csv", True, False)
        'open an existing csv file with writing ability
        Set objTF = objFSO.OpenTextFile("C:\test\myfile.csv", 8) 
    

    will create/open a CSV with FSO.

    The CSV can then be modified by writing to it

    While this is an Excel example you can use the same technique to write records from Outlook, Access, Word etc

    Const sFilePath = "C:\test\myfile.csv"
    Const strDelim = ","
    Sub CreateCSV_FSO()
        Dim objFSO
        Dim objTF
        Dim ws As Worksheet
        Dim lRow As Long
        Dim lCol As Long
        Dim strTmp As String
        Dim lFnum As Long
    
        Set objFSO = CreateObject("scripting.filesystemobject")
        Set objTF = objFSO.createtextfile(sFilePath, True, False)
    
        For Each ws In ActiveWorkbook.Worksheets
            'test that sheet has been used
            Set rng1 = ws.UsedRange
            If Not rng1 Is Nothing Then
                'only multi-cell ranges can be written to a 2D array
                If rng1.Cells.Count > 1 Then
                    X = ws.UsedRange.Value2
                    'The code TRANSPOSES COLUMNS AND ROWS by writing strings column by column
                    For lCol = 1 To UBound(X, 2)
                        'write initial value outside the loop
                        strTmp = IIf(InStr(X(1, lCol), strDelim) > 0, """" & X(1, lCol) & """", X(1, lCol))
                        For lRow = 2 To UBound(X, 1)
                            'concatenate long string & (short string with short string)
                            strTmp = strTmp & (strDelim & IIf(InStr(X(lRow, lCol), strDelim) > 0, """" & X(lRow, lCol) & """", X(lRow, lCol)))
                        Next lRow
                        'write each line to CSV
                        objTF.writeline strTmp
                    Next lCol
                Else
                    objTF.writeline IIf(InStr(ws.UsedRange.Value, strDelim) > 0, """" & ws.UsedRange.Value & """", ws.UsedRange.Value)
                End If
            End If
        Next ws
    
        objTF.Close
        Set objFSO = Nothing
        MsgBox "Done!", vbOKOnly
    
    End Sub