Samples of VBA code I'm using in my daily tasks.

Wednesday, March 17, 2010

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


1 comment: