• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• This code writes the contents of an ADO RecordSet to a ascii text file with user specified column &

This code writes the contents of an ADO RecordSet to a ascii text file with user specified column &

This code writes the contents of an ADO RecordSet to a ascii text file with user specified column & row delimiters. Simple but usefull.

Rate This code writes the contents of an ADO RecordSet to a ascii text file with user specified column &

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'Revision History:
'
'         26/07/1999 GC - v1.00.0000 Initial Version.
'
'Notes: Writes a record set to a file in ascii text mode.

Option Explicit

Private iFileNumber As Integer
Private sFilePath As String
    
Private sDelimeter As String
Private sRowDelimeter As String

Private lErrorNumber As Long
Private sErrorDescription As String
Private sErrorPlace As String

Public Property Get GetErrorNumber() As Long
    GetErrorNumber = lErrorNumber
End Property

Public Property Get GetErrorDescription() As String
    GetErrorDescription = sErrorDescription
End Property

Public Property Get GetErrorPlace() As String
    GetErrorPlace = sErrorPlace
End Property

Public Property Let FilePath(ByVal inFilePath As String)
    sFilePath = inFilePath
End Property

Public Property Get GetFilePath() As String
    GetFilePath = sFilePath
End Property

Public Property Let Delimeter(ByVal inDelimeter As String)
    sDelimeter = inDelimeter
End Property

Public Property Get GetDelimeter() As String
    GetDelimeter = sDelimeter
End Property

Public Property Let RowDelimeter(ByVal inRowDelimeter As String)
    sRowDelimeter = inRowDelimeter
End Property

Public Property Get GetRowDelimeter() As String
    GetRowDelimeter = sRowDelimeter
End Property

Public Function Write2File(Optional ByRef inRecordSet As ADODB.Recordset, _
                           Optional ByRef inFilePath As String, _
                           Optional ByRef inDelimeter As String, _
                           Optional ByRef inRowDelimeter As String, _
                           Optional ByRef inAppend As Boolean, _
                           Optional ByRef inHeaderRecord As String) As Long

On Error GoTo ErrorHandler
'Default: Delimeter is ","
'         RowDelimeter is VBCrLF

    Dim sTempRecord As String
    Dim dRecords As Double
    Dim dIndex As Double
    Dim iCol As Integer
    Dim iMaxCols As Integer
    
    'Check if anything to do
    If (IsEmpty(inRecordSet)) Then
        Exit Function
    Else
        If (inRecordSet.RecordCount = 0) Then
            Exit Function
        Else
            dRecords = inRecordSet.RecordCount
        End If
    End If
    
    'File Path
    If (Len(inFilePath) > 0) Then
        sFilePath = inFilePath
    Else
        If (Len(sFilePath) < 1) Then
            Exit Function
        End If
    End If
              
    'Set up the Column Delimeter
    If (Len(inDelimeter) > 0) Then
        sDelimeter = inDelimeter
    Else
        If (Len(sDelimeter) < 1) Then
            sDelimeter = ","
        End If
    End If
    
    'Set up the Row Delimeter
    If (Len(inRowDelimeter) > 0) Then
        sRowDelimeter = inRowDelimeter
    Else
        If (Len(sRowDelimeter) < 1) Then
            sRowDelimeter = vbCrLf
        End If
    End If
    
    Call OpenFile(inAppend)
    If (Len(inHeaderRecord) > 0) Then
        Print #iFileNumber, inHeaderRecord
    End If
        
    iMaxCols = inRecordSet.Fields.Count - 1
    
    inRecordSet.MoveFirst
    'This if statement is to accomodate a bug in .movenext
    'where the record set only contains one record...
    If (dRecords = 1) Then
        sTempRecord = inRecordSet.Fields(0).Value
        For iCol = 1 To iMaxCols
            sTempRecord = sTempRecord & sDelimeter & inRecordSet.Fields(iCol).Value
        Next iCol
        Print #iFileNumber, sTempRecord
    Else
        While dIndex < dRecords
            sTempRecord = inRecordSet.Fields(0).Value
            For iCol = 1 To iMaxCols
                sTempRecord = sTempRecord & sDelimeter & inRecordSet.Fields(iCol).Value
            Next iCol
            Print #iFileNumber, sTempRecord
            dIndex = dIndex + 1
            inRecordSet.MoveNext
        Wend
    End If
    
    CloseFile
    
    DoEvents
    Exit Function
ErrorHandler:
    lErrorNumber = Err.Number
    sErrorDescription = Err.Description
    sErrorPlace = "OpenInterfaceFile()"
End Function

Private Sub OpenFile(ByRef inAppend As Boolean)
On Error GoTo ErrorHandler
    iFileNumber = FreeFile
    If (inAppend) Then
        'Check if Error file already exists
        If (Dir(sFilePath) = "") Then
            Open sFilePath For Output As #iFileNumber
        Else
            Open sFilePath For Append As #iFileNumber
        End If
    Else
        Open sFilePath For Output As #iFileNumber
    End If
    Exit Sub
ErrorHandler:
    lErrorNumber = Err.Number
    sErrorDescription = Err.Description
    sErrorPlace = "OpenLogFile()"
End Sub

Private Sub CloseFile()
On Error GoTo ErrorHandler
    Close #iFileNumber
    Exit Sub
ErrorHandler:
    lErrorNumber = Err.Number
    sErrorDescription = Err.Description
    sErrorPlace = "CloseInterfaceFile()"
End Sub