Save Recordset To CSV File

Public Sub SaveRecordsetToCSV()
    Dim rsTemp As ADODB.Recordset
    Set rsTemp = New ADODB.Recordset
    
    rsTemp.Open "MyTableName", CurrentProject.Connection, adOpenStatic, adLockOptimistic
 
    Dim CSVData As String
    CSVData = RecordsetToCSV(rsTemp, True)
 
    Open "C:\MyFileName.csv" For Binary Access Write As #1
        Put #1, , CSVData
    Close #1
    
    rsTemp.Close
    Set rsTemp = Nothing
End Sub


Public Function RecordsetToCSV(rsData As ADODB.Recordset, _
        Optional ShowColumnNames As Boolean = True, _
        Optional NULLStr As String = "") As String
    'Function returns a string to be saved as .CSV file
    'Option: save column titles

    Dim K As Long, RetStr As String
    
    If ShowColumnNames Then
        For K = 0 To rsData.Fields.Count - 1
            RetStr = RetStr & ",""" & rsData.Fields(K).Name & """"
        Next K
        
        RetStr = Mid(RetStr, 2) & vbNewLine
    End If
    
    RetStr = RetStr & """" & rsData.GetString(adClipString, -1, """,""", """" & vbNewLine & """", NULLStr)
    RetStr = Left(RetStr, Len(RetStr) - 3)
    
    RecordsetToCSV = RetStr
End Function

Write Table Or Query To CSV File

' 
Public Sub ExportDelim(strTableOrQuery As String, strExportFile As String, _
                        Optional blnHeader As Boolean, _
                        strDelimiter As String, Optional TxtQualifier As String)
'INPUT:
' strTableOrQuery   is the table or query name
' strExportFile     is the full path and name of file to export to
' blnHeader         export column titles: True / False
' strDelimiter      is the field deliminator: Chr(9) for tab or Chr(44) for comma
' TxtQualifier      is optinal double qoutes Chr (34)
'OUTPUT:
' Delimited text file; fields can be souranded with quotes TxtQualifier
    Dim fld As Field
    Dim varData As Variant
    Dim rs As Recordset
    Dim intFileNum As Integer
    
    
    'set recordset on table or query
    Set rs = CurrentDb.OpenRecordset(strTableOrQuery, dbOpenSnapshot)
      
    'get file handle and open for output
    intFileNum = FreeFile()
      
    Open strExportFile For Output As #intFileNum
      
    If blnHeader Then
        'output the header row if requested
        varData = ""
        For Each fld In rs.Fields   'traverse the fields collection
            varData = varData & TxtQualifier & fld.Name & TxtQualifier & strDelimiter
        Next
          
        'remove extra last strDelimiter
        varData = Left(varData, Len(varData) - 1)
        'write out the header row
        Print #intFileNum, varData
    End If
      
    'now your data
    Do While Not rs.EOF
        varData = ""
        'concatenate the data row
        For Each fld In rs.Fields
            varData = varData & TxtQualifier & fld.Value & TxtQualifier & strDelimiter
        Next
        
        'remove extra last strDelimiter
        varData = Left(varData, Len(varData) - 1)
        'write out data row
        Print #intFileNum, varData
        rs.MoveNext
    Loop
      
    Close #intFileNum
    rs.Close
    Set rs = Nothing
End Sub

Merge Text Files FSO

' You can create a function that receives three file names.
' Needs References to Microsoft Scripting Runtime

' Merge two text files
fHeader = "C:\MyHeaderFile.csv"
fData = "C:\MyDataFile.csv"
fOut = "C:\NewFile.csv"

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile(fOut)

Set objTextFile = objFSO.OpenTextFile(fHeader, ForReading)

strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText

Set objTextFile = objFSO.OpenTextFile(fData & " ", ForReading)

strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText

objOutputFile.Close

Mass replace characters in a text file

'--------------------------------------------------------------------
' sFile - path and file name of your file
' sNewFile - new file name, can be same like old file name
' sFind - text you want to replace (can be special character like: vbCrLf)
' sReplace - new text
'
Public Sub TextFileReplace(ByVal sFile As String, ByVal sNewFile As String, ByVal sFind As String, ByVal sReplace As String)
Dim iFile As Integer
Dim sTextBuffer As String
'
' Get the next available file handle
iFile = FreeFile
' Open the source file (sFile) for read access
Open sFile For Binary Access Read As iFile
' Create a buffer that will hold the contents of the file
sTextBuffer = Space(LOF(iFile))
' Read the contents of the file into the buffer
Get #iFile, , sTextBuffer
' Close the file
Close iFile

' Use the "Replace" function to replace all instances of
' (sFind) in the buffer with the value in (sReplace)
sTextBuffer = Replace(sTextBuffer, sFind, sReplace)

' Get the next available file handle
iFile = FreeFile
' Open/Create the new file for write access
Open sNewFile For Binary Access Write As iFile
' Write the modified buffer contents to the file
Put #iFile, , sTextBuffer
' Close the file
Close iFile
End Sub
'--------------------------------------------------------------------

Example Usage:
'--------------------------------------------------------------------
Call TextFileReplace("C:\MyFile.csv", "C:\NewFileName.txt", "IT_Number", "IT_Nbr")
'--------------------------------------------------------------------

Read Text File

Use VBA to read a text file line by line, the whole file, and one by one character.

Dim objSource
Dim strLine
Dim objFSO
Const ForReading = 1    
Dim strFile As String
Dim strTempFile As String

strTextFile = "C:\MyFileName.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSource = objFSO.OpenTextFile(strTextFile, ForReading)
       
' Read file line by line
Do Until objSource.AtEndOfStream
    strLine = objSource.ReadLine
    'Processing data
    Debug.Print strLine
Loop
       
' Read file in one big buffer
strTextBuffer = objSource.ReadAll
Debug.Print strTextBuffer
       
objSource.Close
Set objSource = Nothing
Set objFSO = Nothing
       
'----------------------------------------
       
'To read the file one by one character use this:
Dim MyChar
Open "C:\MyTextFile.txt" For Input As #1      ' Open file.
Do While Not EOF(1)        ' Loop until end of file.    
  MyChar = Input(1, #1)    ' Get one character.      
  Debug.Print MyChar       ' Print to the Immediate window.
Loop
Close #1    ' Close file.