RecordCount
 

Αγαπητοί φίλοι καλησπέρα.

Μπήκα στην διαδικασία να ζητήσω την βοήθεια σας μιας και κόλλησα σε κάτι το οποίο είναι πολύ σημαντικό για την εφαρμογή που αναπτύσω και δεν μπορώ να καταφέρω αυτό που θέλω.

Το ζητούμενο είναι το εξής: Έχω ένα ερώτημα με κριτήρια το οποίο μετράει εγγραφές και ένα πεδίο σε μια φόρμα, το οποίο με την συνάρτηση DCount μετράω τις συνολικές εγγραφές του ερωτήματος. Μέχρι εδώ καλά. Όμως επειδή θέλω η μέτρηση να γίνεται στο OnTimer της φόρμας με ρυθμό ανανέωσης το 1 δευτερόλεπτο, η συνάρτηση DCount είναι πολύ αργή. Έτσι αναγκαστικά πρέπει να χρησιμοποιήσω την συνάρτηση RecordCount η οποία είναι πάρα πολύ γρήγορη και δεν έχω θέματα καθυστέρησης της φόρμας.

Έχω γράψει αυτόν τον κώδικα:
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("SELECT Data.Barcode FROM Data WHERE '((Data.UsBadStation01)=1 AND (Data.UsBadStation02)=0 AND (Data.Schicht)=[forms]![Visual Control].[Schiht] AND (Data.Nacharbeit)=No AND (Data.Schrott)=No AND (DateValue([TimeStamp])=Date()));'", , adOpenKeyset)
Me.Stuck = objRecordset.RecordCount

Το πρόβλημα που αντιμετωπίζω είναι το εξής: Πρώτον αν χρησιμοποιήσω σαν Recordset το ερώτημα που έχω φτιάξει μου επιστρέφει μήνυμα λάθους "too few parameters expected 1 ".
Αν χρησιμοποιήσω σαν RecordSet τον πίνακα με τις εγγραφές (Βλέπε κώδικα) λειτουργεί, όμως δεν μου επιστρέφει τον σωστό αριθμό εγγραφών,με τα κριτήρια που έχω ορίσει, αλλά μου επιστρέφει όλες τις εγγραφές της βάσης που είναι πάνω από 1,5 μύριο με αποτέλεσμα να έχω μια καθυστέρηση όχι πολύ αλλά ενοχλητική.

Η Ερώτηση μου είναι: Γνωρίζει κάποιος πώς μπορώ να καταφέρω αυτό που θέλω?? Γνωρίζει κανείς γιατί τα κριτήρια μου στην VBA δεν λειτουργούν ενώ στο ερώτημα λειτουργούν άψογα??
Υπάρχει κάποιο λάθος στον κώδικα μου??

Αν μπορεί κάποιος να με βοηθήσει έστω και με άλλον τρόπο θα του είμαι ευγνώμων.
Σας ευχαριστώ εκ των προτέρων!

Update: Βρήκα αυτόν τον κώδικα με ακαριαία αποτελέσματα και χωρίς καθόλου καθυστέρηση όμως πάλι δεν δουλεύει με τον ερώτημα ή με τα κριτήρια που δίνω.:too_angry::too_angry:
Function recordCount()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String

Set db = CurrentDb

'Count Query - replace query with your
'Query of Choice
strSQL = "SELECT COUNT(*) FROM [Data]"
'Set Recordset Query
Set rs = db.OpenRecordset(strSQL)

'Return Record Count Variable
recordCount = rs.Fields(0)

'Close Connections and Reset Variables
rs.Close
Set rs = Nothing
Set db = Nothing
End Function

Συνημμένο Αρχείο 8894

Χρήστο καλησπέρα,

Μία βάση με 1,5 εκ δεν την λες και μικρή (χωρίς βέβαια να γνωρίζω το πλήθος των πεδίων που έχει ο πίνακας).

Κατά την γνώμη μου θα πρέπει να αυξήσεις τον χρόνο του 1 δευτερολέπτου για να αφήσεις το περιθώριο στην φόρμα να κάνει την ανανέωση. Επίσης, σε τέτοιους όγκους ίσως είναι απαραίτητο, αν δεν έχεις δημιουργήσεις Index να κάνεις και αυτό.

Λαμβάνοντας υπόψιν μου τον 2ο κώδικα που αναφέρεις, ενσωμάτωσα ταυτόχρονα σε μία δική μου φόρμα τόσο το πλήθος εγγραφών ενός πίνακα με 2.600 όσο και ενός ερωτήματος με 1150 εγγραφές (στον ίδιο κώδικα).

Διαπίστωσα λοιπόν ότι το πλήθος των εγγραφών του ερωτήματος εμφανίζεται μετά από 1 δευτερόλεπτο ενώ του πίνακα αμέσως. Αν συνυπολογίσουμε ότι το πλήθος της δικής σου βάσης είναι κατά πολύ μεγαλύτερο, θα πρέπει να αυξήσεις τον χρόνο ανανέωσης με τέτοιο τρόπο προκειμένου να παρέρχεται ο απαραίτητος χρόνος που χρειάζεται για να μετρήσει τις εγγραφές.

Γρηγόρης

Αγαπητέ φίλε σ'ευχαριστώ για το ενδιαφέρον σου να με βοηθήσεις.
Το πρόβλημα μου δεν είναι στο πόσο μεγάλη είναι η βάση (παρεπιπτόντως κάθε μέρα προστίθενται 3500 εγγραφές περίπου), αλλά το ότι δεν λειτουργούν τα κριτήρια. Και απο ότι το έψαξα περαιτέρω ο κώδικας χτυπάει όταν ζητάω κριτήριο πεδίο απο την φόρμα. Εκεί είναι το λάθος και δεν μπορώ να βρώ την σωστή σύνταξη να το καταφέρω.
Την ανανέωση του 1 δευτερολέπτου την χρειάζομαι μιας και πρέπει να μετριούνται τα κομμάτια On Line!
Ο δεύτερος κώδικας που πόσταρα ακόμα και το 1,5 μύριο το μετράει ακαριαία χωρίς καθόλου καθυστέρηση!! :wink:

Σ'ευχαριστώ και πάλι!!

Χρήστο,
Ίσως θα ήταν χρήσιμο να ανεβάσεις ένα demo της βάσης σου για να το δουν και τα υπόλοιπα μέλη και ίσως έτσι κατανοήσουμε καλύτερα το πρόβλημά σου,

Γρηγόρης

Αυτό σκοπεύω να κάνω! :)

Ανεβάζω δείγμα της βάσης! Κάθε βοήθεια δεκτή! Ακόμα και στον κώδικα αν υπάρχει ιδέα για να γίνει μικρότερος, καλύτερος και ακόμα πιο γρήγορος...δεκτή!!! :)
Έβαλα λίνκ γιατί είναι μεγάλη η βάση.

Κατέβασμα απο εδώ------->https://1drv.ms/u/s!ApBEZ9s0jK_sgdpF3SkOiJvzZTcbIA

Χρήστο καλησπέρα,

Έχεις το εξής :
Me.SystemTime = Format(Now(), "hh:mm:ss") 'Takes the System Time'

Αντικατέστησε το με αυτό :

Me.SystemTime = Strings.Format(Now(), "hh:mm:ss") 'Takes the System Time'


Γρηγόρης

Για εξήγησε μου το αυτό. Τι ακριβώς κάνει?

Καλησπέρα,

Διευρένησα το σημείο του κώδικα που "χτύπαγε" ως προς την σύνταξή του.

Την λύση την βρήκα στην κάτωθι ιστοσελίδα :

https://www.mrexcel.com/forum/excel-...ons-macro.html

Λειτουργεί σωστά τώρα;

Στην διάθεσή σου

Γρηγόρης

Το πρόβλημα στην σύνταξη είναι εδώ. (Έντονα γράμματα)
Call objRecordset.Open("SELECT COUNT(*) FROM [Data] WHERE ((Data.UsBadStation01)=1 AND (Data.UsBadStation02)=0 AND (Data.Schicht)=[forms]![Visual Control].[Schiht] AND (Data.Nacharbeit)=No AND (Data.Schrott)=No AND (DateValue([TimeStamp])=Date()));")

Τα κριτήρια που θέλω λειτουργούν εκτός απο αυτό που είναι επίσης σημαντικό!

Αν αλλάξεις το strSQL με αυτό strSQL = ("SELECT COUNT(*) FROM [Data] WHERE ((Data.UsBadStation01)=1 AND (Data.UsBadStation02)=0 AND (Data.Nacharbeit)=No AND (Data.Schrott)=No AND (DateValue([TimeStamp])=Date()));") Θα σου φέρει αλλές εγγραφές! Και θα έχει και καθυστέρηση στην φόρμα!