[VB6] Debug RecordSet

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 Function

Discover more from naiwaen@DebuggingSoft

Subscribe to get the latest posts sent to your email.