Solved Recordset Class and display all Records (1 Viewer)

[silentwolf]

Hi guys,

got a little lost with my class attempt of recordset Class where I would like to get some help from you please.

I have created a very simple clsDatensaetze

Dim m_rcsDaten As Recordset
Dim m_strRecordsetName As String
'

Sub OeffneRecordset(strName As String)
    m_strRecordsetName = strName
    Set m_rcsDaten = CurrentDb.OpenRecordset(m_strRecordsetName, dbOpenDynaset)
End Sub

And here my module to test the Class

Private Sub TestRecordset()
    Dim rcsD As clsDatensaetze
   
    Set rcsD = New clsDatensaetze
   
    rcsD.OeffneRecordset ("SELECT *FROM AUSZUG WHERE [TestField] LIKE'*OrderNumber:*'")
   
'here how to I loop through all found OrderNumber in the Recordset???

'    Do Until rcsD.EOF
'        Debug.Print "Name: " & rcsD.Fields("TestField").Value
'        rcsD.MoveNext
'    Loop   
   
  Set rcsD = Nothing

End Sub

How to I need to change it to be able to use the Class to retrieve also all records?

I got alot of the same kind of Methodes and I would love to reduce my code and limit redundance Code.


Thanks for your help

Cheers

 

[CJ_London]

struggling to see what the benefits are of a recordset class. but in your class module you could have a property get that returns a recordset

 

[arnelgp]

DAO.Recordset is already a Class, why re-invent it?

there is a Pre-made Recordset class in Northwind database (desktop version).

Option Compare Database
Option Explicit

Private m_rs As DAO.Recordset2


Public Function GetRecordsetClone(rs As DAO.Recordset2) As DAO.Recordset2
    If Not m_rs Is Nothing Then
        Debug.Assert False ' This is only designed to be used once
    Else
        Set m_rs = rs.Clone
        Set GetRecordsetClone = m_rs
    End If
End Function


Public Function OpenRecordset(Domain As String, _
                              Optional Criteria As String = "1=1", _
                              Optional OrderBy As String, _
                              Optional RecordsetType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                              Optional RecordsetOptions As DAO.RecordsetOptionEnum _
                              ) As Boolean
    
    
    If Not m_rs Is Nothing Then
        ' Close the recordset so it can be re-used
        CloseRecordset
    End If
    
    Dim strSQL As String
    strSQL = "SELECT * FROM [" & Domain & "] WHERE " & Criteria
    
    If OrderBy <> "" Then
        strSQL = strSQL & " ORDER BY " & OrderBy
    End If
    
    On Error GoTo ErrorHandler
    Set m_rs = CurrentDb.OpenRecordset(strSQL, RecordsetType, RecordsetOptions)
    OpenRecordset = True

Done:
    Exit Function
ErrorHandler:
    ' verify the private Recordset object was not set
    Debug.Assert m_rs Is Nothing
    
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.OpenRecordset", "strSQL = " & Chr(34) & strSQL & Chr(34)) Then Resume
End Function


Public Function Delete() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Delete
    Delete = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Delete") Then Resume
End Function


Public Function AddNew() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.AddNew
    AddNew = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.AddNew") Then Resume
End Function


Public Function Edit() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Edit
    Edit = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Edit") Then Resume
End Function


Public Function Update() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Update
    Update = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Update") Then Resume
End Function


Public Function MoveNext() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.MoveNext
    MoveNext = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.MoveNext") Then Resume
End Function


Public Function CloseRecordset() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Close
    CloseRecordset = True
    
Done:
    Set m_rs = Nothing
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.CloseRecordset") Then Resume
End Function


Public Property Get Recordset() As DAO.Recordset2
    Set Recordset = m_rs
End Property


Private Sub Class_Terminate()
    If Not m_rs Is Nothing Then
        m_rs.Close
        Set m_rs = Nothing
    End If
End Sub

 

[silentwolf]

Hi,
thanks for your reply.
Well I do have heaps of exact same Methodes I need to do in one of my projects.

All starting with the same thing.
Open a recordset do a filter and then update records .. so I was hoping to not need to write on each of the methodes the same code lines over and over again.

For example I do have a property Get to get the amount of Recordsets in my Class..

Property Get AnzahlDatensaetze() As Long
    If m_rcsDaten Is Nothing Then
        AnzahlDatensaetze = -1
    Else
        With m_rcsDaten
            .MoveLast
            AnzahlDatensaetze = m_rcsDaten.RecordCount
            .MoveFirst
        End With
    End If
End Property

But I do not know how to set it up to get all records back from it.

So I can display those records if needet.

Sub GetMandatsnummer(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE'*Mandatsnummer:*'", dbOpenDynaset)
        
    Do Until rcsP.EOF
    
    rcsP.Edit
    
    rcsP.Fields("Mandatsnummer").Value = AddMandatsnummer(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
End Sub

this is one of the methode I do have in a normal Module and there a heaps of them with the exact same type Structure.
So I was hoping to shorten all that code.

AddMandatsnummer Is a function to get me those numbers out of the text. But as I mentioned I do have many of those.

 

[silentwolf]

Hi arnelgp,
thanks for your reply did come in when I was writing.

DAO.Recordset is already a Class, why re-invent it?

there is a Pre-made Recordset class in Northwind database (desktop version).

Ok thanks for this I will have a look at the Database!
But how can I apply it correctly to my needs?

Sorry for beeing a little confused...

 

[silentwolf]

Ok I got the Northwind and I guess be able to work it out from there

Cheers for pointing out that Database to me did not know that there where also modules in it.

 

[MajP]

Going back to your example and why it makes no sense

Private Sub TestRecordset()
    Dim rcsD As clsDatensaetze
    Set rcsD = New clsDatensaetze
    rcsD.OeffneRecordset ("SELECT *FROM AUSZUG WHERE [TestField] LIKE'*OrderNumber:*'")
  
'here how to I loop through all found OrderNumber in the Recordset???

'    Do Until rcsD.EOF
'        Debug.Print "Name: " & rcsD.Fields("TestField").Value
'        rcsD.MoveNext
'    Loop   
  Set rcsD = Nothing
End Sub

rcsD is an object of ClasDatensaetze
That class has two properties
Name 'String
RcsDaten ' a recordset

ClsDatensaize does not have records or fields or anything like that. It has a recordset that does

Do Until rcsD.EOF

makes no sense
Do until rcsD.rcsDaten.EOF makes sense

In general you should have setters and getters for your properties. You can refer directly to the class variables if you make them public, but in general that is bad form.

FYI. None of your examples are of any use. I understand the concept of wrapping a recordset in another class to help with common, repeated activities. Your examples did none of that. They saved no work. You made a DAO wrapper and only added work not reduced it. Maybe if you gave some meaningful examples of common methods this would make sense.

 

[silentwolf]

Hi MajP,

Ok I try to explain again and a little more in Detail what I am doing or trying to do.

I need to update in regular bases a long list of Statements. Lots of string manipulations are repuired.

Therefore I need to update or edit that string with multiple and different functions to be able to do so.

As I always need to open the Recordset with the same Paramters (same Table) same just different Parameters I thought to wrap it into a class so I save some typing.

Sub GetMandatsnummer(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE'*Mandatsnummer:*'", dbOpenDynaset)
        
    Do Until rcsP.EOF
    
    rcsP.Edit
    
    rcsP.Fields("Mandatsnummer").Value = AddMandatsnummer(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
End Sub

Sub GetAuftraggeber(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE'*Auftraggeberreferenz:*'", dbOpenDynaset)
        
    Do Until rcsP.EOF
    
    rcsP.Edit
    
    rcsP.Fields("Auftraggeber").Value = AddAuftraggeberReference(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
End Sub

and there are many of them.. which are similar in the way they start of open a recordset and so on....

So those Methodes above work but I was just hoping to get those a little bit less in typing and also was wondering how you could do that a little better with using classes.

But I can just continue like that that is also ok was just currious if there is a better way.

But I guess there is not and it is getting more complicated and more to write then less.

 

[CJ_London]

Open a recordset do a filter and then update records .. so I was hoping to not need to write on each of the methodes the same code lines over and over again.

so you still need to populate your class with the sql for the recordset, the filters/criteria, that table you want to update, etc. And within that you need to cater for different field types and then return back the result.

Agree with MajP all you are doing is creating work and complications

As I always need to open the Recordset with the same Paramters (same Table)

You can just use a public function to do that to return an opened recordset

Function GetMandatsnummer(strTable As String) as dao.recordset
 
    Set GetMandatsnummer = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE '*Mandatsnummer:*'", dbOpenDynaset)
        
end function

Therefore I need to update or edit that string with multiple and different functions to be able to do so.

no evidence of that in your examples

 

[silentwolf]

Hi CJLondon,

Sorry I am completly confused now.

What are you trying to tell me?

no evidence of that in your examples

Should I post all of my code to show that there are more of the same thing?

Sub GetMandatsnummer(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE'*Mandatsnummer:*'", dbOpenDynaset)
        
    Do Until rcsP.EOF
    
    rcsP.Edit
    
    rcsP.Fields("Mandatsnummer").Value = AddMandatsnummer(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
End Sub

Sub GetAuftraggeber(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT * FROM " & strTable & " WHERE Umsatztext LIKE'*Auftraggeberreferenz:*'", dbOpenDynaset)
        
    Do Until rcsP.EOF
    
    rcsP.Edit
    
    rcsP.Fields("Auftraggeber").Value = AddAuftraggeberReference(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
End Sub


'==================Functions=======================



Function AddMandatsnummer(ByVal strText As String) As String
    Dim intPos As Integer
    Dim intPos2 As Integer
    Dim intLen As Integer

    Select Case True

        Case strText Like "*Mandatsnumm*"
            If strText Like "*Auftraggeber*" Then
                intPos = InStr(strText, "Mandatsnummer")
                intPos2 = InStr(strText, "Auftrag")
                intLen = intPos2 - intPos
                AddMandatsnummer = Mid(strText, intPos, intLen - 1)

            ElseIf strText Like "*Kredit*" Then
                intPos = InStr(strText, "Mandatsnummer")
                intPos2 = InStr(strText, "Kredit")
                intLen = intPos2 - intPos
                AddMandatsnummer = Mid(strText, intPos, intLen - 1)

            ElseIf strText Like "*PAYLIFE ABRECHNUNG*" Then
                intPos = InStr(strText, "Mandatsnummer")
                intPos2 = InStrRev(strText, "PAYL")
                intLen = intPos2 - intPos
                AddMandatsnummer = Mid(strText, intPos, intLen - 1)
            Else
                intPos = InStr(strText, "Mandatsnummer")
                intPos2 = InStr(strText, "REF:")
                intLen = intPos2 - intPos
                AddMandatsnummer = Mid(strText, intPos, intLen - 1)
            End If
        Case Else
            AddMandatsnummer = ""
    End Select
End Function


Function AddAuftraggeberReference(ByVal strText As String)
    Dim intPos As Integer
    Dim intPos2 As Integer
    Dim intLen As Integer
    
    If strText Like "*Auftraggeberreferenz*" Then
        intPos = InStr(strText, "Auftraggeberreferenz:")
        intPos2 = InStr(strText, "REF:")
    
        intPos = intPos + 22
        intPos2 = intPos2 - 1
        
        intLen = intPos2 - intPos
        AddAuftraggeberReference = Mid(strText, intPos, intLen)
    Else
        strText = ""
    End If
End Function[Code]

For this I know I don't need a class I was just wondering how you could reduce writing 

'The sub Procedures so it is not the same every time..

maybe I just don't understand or missunderstand it .. 

This is just a part of the code and I am not sure if you liek the hole code to see that there is more of the same or similar code over and over again.

 

[CJ_London]

Sorry, thought you were trying to demonstrate a 'one sub fits all'. Why not just use an update query?

Sub updateATable(tbname as string, crit as string, updateFld as string, updateTo as string)
dim sqlStr as string

    sqlstr="UPDATE " & tbName  & "SET " & updateFld & "=" & updateTo & " WHERE " & crit
   currentdb.execute(sqlstr)
end sub

based on your example data

updateATable "table1","Umsatztext LIKE '*Mandatsnummer:*'","Mandatsnummer","AddMandatsnummer([Umsatztext])"
updateATable "table2","Umsatztext LIKE '*Auftraggeberreferenz:*'","Auftraggeber","AddAuftraggeberReference([Umsatztext])"

 

[silentwolf]

Hi,

Sorry, thought you were trying to demonstrate a 'one sub fits all'.

Lol I am not in a position to demonstrate

No I was trying to find a better way to do the same thing over and over

But of course that is going to get closer to what I am trying to do!!

Sometimes I get so caught up in things that the simplest things are out of reach ... Sorry!!!

Sorry for that!!


Many thanks to you!!

 

[Pat Hartman]

In addition to recordset already being a class which you can parametrize without creating another class on top of the recordset class, Action queries are far more efficient for updating data than VBA loops.

 

[silentwolf]

Hi thanks for your advice!

Yes I did a little different now actually.

I have filtered the Recordset first and then an update Query.

Sub UpdateSEPALastschriften(strTable As String)
    Dim rcsP As DAO.Recordset
    
    Dim strSQL As String
    
    Set rcsP = CurrentDb.OpenRecordset("SELECT AUSZUG.Buchungstext, AUSZUG.Umsatztext, AUSZUG.Zahlungsreferenz, AUSZUG.Auftraggeber " & _
                                    "FROM AUSZUG " & _
                                    "WHERE (((AUSZUG.Buchungstext) Like ""*Abschluss*"")) " & _
                                    "ORDER BY AUSZUG.Umsatztext;")
    Do Until rcsP.EOF
    rcsP.Edit
    
    rcsP.Fields("Zahlungsreferenz").Value = ZahlungsrefText(rcsP.Fields("Umsatztext"))
    rcsP.Fields("Auftraggeber").Value = AuftragrefText(rcsP.Fields("Umsatztext"))
    rcsP.Fields("Umsatztext").Value = Umsatztxt(rcsP.Fields("Umsatztext"))
    
    rcsP.Update
        rcsP.MoveNext
    Loop
    
    Set rcsP = Nothing
    
End Sub

Something down that line that would be efficent or not?

 

[CJ_London]

no - vba in the context of what you are doing is the least efficient method.

 

[silentwolf]

oh ok...
thought as it gets filtered first to only a part of the data it would be ok.
So I should in that respect write the update query and then execute?

Sorry still learning and like to get better and more efficent in it.

 

[CJ_London]

well using sql rather than a recordset reduced around 16 lines of code to 1.

As far as your AddMandatsnummer function is concerned, I don't see what you are trying to achieve

-Not sure why you need Select Case True
- or Case strText Like "*Mandatsnumm*" (since the latter has already been filtered with your criteria 'LIKE '*Mandatsnummer:*'"') unless the idea is to combine this function with the AddAuftraggeberReference function?

-the lines

intPos = InStr(strText, "Mandatsnummer")
intLen = intPos2 - intPos
AddMandatsnummer = Mid(strText, intPos, intLen - 1)
are repeated and should be outside your if clause and don't really need to be determined until after

- you don't need the case else since "" is the default value for AddMandatsnummer

The whole function could be reduced to

Function AddMandatsnummer(ByVal strText As String) As String
    Dim intPos As Integer
    Dim intPos2 As Integer
    Dim intLen As Integer

            If strText Like "*Auftraggeber*" Then
              
                intPos2 = InStr(strText, "Auftrag")

            ElseIf strText Like "*Kredit*" Then
                
                intPos2 = InStr(strText, "Kredit")

            ElseIf strText Like "*PAYLIFE ABRECHNUNG*" Then
              
                intPos2 = InStrRev(strText, "PAYL")
              
            Else
          
              intPos2 = InStr(strText, "REF:")
                
            End If
            
            intPos = InStr(strText, "Mandatsnummer")
            if intPos2>intPos then 'intPos2 has been assigned a (valid) value
                intLen = intPos2 - intPos
                AddMandatsnummer = Mid(strText, intPos, intLen - 1)
           end if

End Function

 

[silentwolf]

Hi again,

I have been also working on it and was again modifying the code.

-Not sure why you need Select Case True
- or Case strText Like "*Mandatsnumm*" (since the latter has already been filtered with your criteria 'LIKE '*Mandatsnummer:*'"') unless the idea is to combine this function with the AddAuftraggeberReference function?

It was still from a previous attempt where I hade more cases combined within but I will change it as it is not necessary like that anymore.

Now I have changed it to something like that and as I got a little Timer Class it shows a big difference in time.

Sub UpdateQueryN()
    Dim strSQL As String
    
    strSQL = "UPDATE qryGutschriften SET qryGutschriften.Zahlungsreferenz = GutschriftZahlungsref([UMSATZTEXT]);"
    CurrentDb.Execute strSQL, dbFailOnError
End Sub

That was a test to get it started I hope that is a good way of doing it?

The Function "GutschriftZahlungsref" has all the Error Handler within.

Like to hear your thoughts on it.

There are so many different ways of updateing it is a little confusing to find the right and best way .. for me at least

 

[CJ_London]

to do this with the updateATable sub you would use

updateATable "qryGutschriften","True","Zahlungsreferenz","GutschriftZahlungsref([UMSATZTEXT])"

tho bit bothered about 'qryGutschriften' as a table name

 

[silentwolf]

tho bit bothered about 'qryGutschriften' as a table name

Oh no it is a Query I created a Query for Each of the "Categories" So to speak.

And then run the Update Query ..

It runs ok and pretty quick is there a issue or could there be an issue doing it like that?