Hi everyone, this is a Code Snippet for debug VB6 RecordSet
Public Sub DebugRecordSet(ByRef padrInput As ADODB.RecorDset)
Dim x As Integer
Dim lstrTmp As String
Dim ladrTmp As ADODB.RecorDset
On Error GoTo LineFail
Set ladrTmp = DupRSS(padrInput)
Call ladrTmp.MoveFirst
'===============================================
'Print Header
lstrTmp = ""
For x = 0 To ladrTmp.Fields.Count - 1
lstrTmp = lstrTmp & ladrTmp.Fields(x).Name & "|"
Next
Debug.Print lstrTmp
'===============================================
'Print Data
Do While Not ladrTmp.EOF
lstrTmp = ""
For x = 0 To ladrTmp.Fields.Count - 1
lstrTmp = lstrTmp & ladrTmp.Fields(x).Value & "|"
Next
Debug.Print lstrTmp
ladrTmp.MoveNext
Loop
LineExit:
Exit Sub
LineFail:
GoTo LineExit
End Sub
Public Function DupRSS(ByVal pRsSource As ADODB.RecorDset) As ADODB.RecorDset
Dim lrsField As ADODB.Field
Dim lrsDupField As ADODB.Field
Dim lRsTemp As ADODB.RecorDset
On Error GoTo LineFail
If pRsSource Is Nothing Then GoTo LineExit
If pRsSource.State <> adStateOpen Then GoTo LineExit
Set DupRSS = New ADODB.RecorDset
For Each lrsField In pRsSource.Fields
Call DupRSS.Fields.Append(lrsField.Name, lrsField.Type, lrsField.DefinedSize, adFldIsNullable)
Set lrsDupField = DupRSS.Fields(lrsField.Name)
lrsDupField.NumericScale = lrsField.NumericScale
lrsDupField.Precision = lrsField.Precision
Next lrsField
DupRSS.Open
Set lRsTemp = pRsSource.Clone
If lRsTemp.RecordCount > 0 Then
lRsTemp.MoveFirst
Do While Not lRsTemp.EOF
DupRSS.AddNew
On Error Resume Next
For Each lrsField In lRsTemp.Fields
DupRSS.Fields(lrsField.Name).Value = lrsField.Value
Next lrsField
lRsTemp.MoveNext
Loop
End If
LineExit:
Exit Function
LineFail:
GoTo LineExit
End FunctionDiscover more from naiwaen@DebuggingSoft
Subscribe to get the latest posts sent to your email.



