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.