sidharthrshah
Programmer
I have the code for converting an access database to comma delimited file.But it requires recordset that has to be exported and I have to open the recordset before passing it to this function.So how do I do this?
I want all the fields of the table sidtable in recordset.
the table fields are : nam,telno,addr
the access file name is collproj.mdb
Please help.
------------------------------------------------------------
'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE
'PARAMETERS:
'RS: Recordset to Export. Open the recordset before
'passing it to this function
'FullPath (Optional): FullPath of text file.
'if not specified, the function uses app.path +
'rs.txt
'ValueDelmiter (Optional): String to delimiter
'values within a row. If not specified, an empty space
'is used
'RETURNS: True if successful, false if an error occurs
-----------------------------------------------------
Public Function RecordsetToText(rs As Object, Optional FullPath _
As String, Optional ValueDelimiter As String = " "
As Boolean
'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE
'PARAMETERS:
'RS: Recordset to Export. Open the recordset before
'passing it to this function
'FullPath (Optional): FullPath of text file.
'if not specified, the function uses app.path +
'rs.txt
'ValueDelmiter (Optional): String to delimiter
'values within a row. If not specified, an empty space
'is used
'RETURNS: True if successful, false if an error occurs
'COMMENTS: Rows are delimited by a carriage return
Dim sFullPath As String
Dim sDelimiter As String
Dim iFileNum As Integer
Dim lFieldCount As Long
Dim lCtr As Long
Dim oField As ADODB.Field
On Error GoTo ErrorHandler:
If RecordSetReady(rs) = False Then Exit Function
MsgBox ("the function has sarted"
sDelimiter = ValueDelimiter
If FullPath = "" Then
sFullPath = App.Path
If Right(sFullPath, 1) <> "\" Then sFullPath = _
sFullPath & "\"
sFullPath = sFullPath & "rs.txt"
Else
sFullPath = FullPath
End If
iFileNum = FreeFile
Open sFullPath For Output As #iFileNum
With rs
lFieldCount = .Fields.Count - 1
On Error Resume Next
.MoveFirst
On Error GoTo ErrorHandler
Do While Not .EOF
For lCtr = 0 To lFieldCount
Set oField = .Fields(lCtr)
If FieldCanBeString(oField) Then
If lCtr < lFieldCount Then
Print #iFileNum, oField.Name & ":" & _
oField.Value & sDelimiter;
Else
Print #iFileNum, oField.Name & ": " & oField.Value
End If
End If
Next
.MoveNext
Loop
End With
RecordsetToText = True
ErrorHandler:
On Error Resume Next
Close #iFileNum
End Function
Private Function RecordSetReady(rs As Object) As Boolean
'Recordset must be opened and connected
On Error Resume Next
If rs Is Nothing Then Exit Function
If Not TypeOf rs Is ADODB.Recordset Then Exit Function
If rs.State = 0 Then
'attempt to open, requires source has populated and either
'source or recordset has an active connection
On Error Resume Next
rs.open
If Err.Number <> 0 Then Exit Function
End If
RecordSetReady = True
End Function
Private Function FieldCanBeString(oField) _
As Boolean
If IsObject(FieldObj.Value) Then
FieldCanBeString = False
Else
'Assumes adEmpty will be converted to ""
'Doesn't check for null value because
'Assumes null will be converted to ""
Select Case FieldObj.Type
Case adBinary, adIDispatch, adIUnknown, adUserDefined
FieldCanBeString = False
Case Else
FieldCanBeString = True
End Select
End If
End Function
'Private Function RecordSetReady1(rs As Object) As Boolean
'End Function
I want all the fields of the table sidtable in recordset.
the table fields are : nam,telno,addr
the access file name is collproj.mdb
Please help.
------------------------------------------------------------
'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE
'PARAMETERS:
'RS: Recordset to Export. Open the recordset before
'passing it to this function
'FullPath (Optional): FullPath of text file.
'if not specified, the function uses app.path +
'rs.txt
'ValueDelmiter (Optional): String to delimiter
'values within a row. If not specified, an empty space
'is used
'RETURNS: True if successful, false if an error occurs
-----------------------------------------------------
Public Function RecordsetToText(rs As Object, Optional FullPath _
As String, Optional ValueDelimiter As String = " "
As Boolean'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE
'PARAMETERS:
'RS: Recordset to Export. Open the recordset before
'passing it to this function
'FullPath (Optional): FullPath of text file.
'if not specified, the function uses app.path +
'rs.txt
'ValueDelmiter (Optional): String to delimiter
'values within a row. If not specified, an empty space
'is used
'RETURNS: True if successful, false if an error occurs
'COMMENTS: Rows are delimited by a carriage return
Dim sFullPath As String
Dim sDelimiter As String
Dim iFileNum As Integer
Dim lFieldCount As Long
Dim lCtr As Long
Dim oField As ADODB.Field
On Error GoTo ErrorHandler:
If RecordSetReady(rs) = False Then Exit Function
MsgBox ("the function has sarted"
sDelimiter = ValueDelimiter
If FullPath = "" Then
sFullPath = App.Path
If Right(sFullPath, 1) <> "\" Then sFullPath = _
sFullPath & "\"
sFullPath = sFullPath & "rs.txt"
Else
sFullPath = FullPath
End If
iFileNum = FreeFile
Open sFullPath For Output As #iFileNum
With rs
lFieldCount = .Fields.Count - 1
On Error Resume Next
.MoveFirst
On Error GoTo ErrorHandler
Do While Not .EOF
For lCtr = 0 To lFieldCount
Set oField = .Fields(lCtr)
If FieldCanBeString(oField) Then
If lCtr < lFieldCount Then
Print #iFileNum, oField.Name & ":" & _
oField.Value & sDelimiter;
Else
Print #iFileNum, oField.Name & ": " & oField.Value
End If
End If
Next
.MoveNext
Loop
End With
RecordsetToText = True
ErrorHandler:
On Error Resume Next
Close #iFileNum
End Function
Private Function RecordSetReady(rs As Object) As Boolean
'Recordset must be opened and connected
On Error Resume Next
If rs Is Nothing Then Exit Function
If Not TypeOf rs Is ADODB.Recordset Then Exit Function
If rs.State = 0 Then
'attempt to open, requires source has populated and either
'source or recordset has an active connection
On Error Resume Next
rs.open
If Err.Number <> 0 Then Exit Function
End If
RecordSetReady = True
End Function
Private Function FieldCanBeString(oField) _
As Boolean
If IsObject(FieldObj.Value) Then
FieldCanBeString = False
Else
'Assumes adEmpty will be converted to ""
'Doesn't check for null value because
'Assumes null will be converted to ""
Select Case FieldObj.Type
Case adBinary, adIDispatch, adIUnknown, adUserDefined
FieldCanBeString = False
Case Else
FieldCanBeString = True
End Select
End If
End Function
'Private Function RecordSetReady1(rs As Object) As Boolean
'End Function
