Forum - Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/146-kodikas-gia-na-leitoyrgei-i-basi-gia-sygkekrimenes-meres.html)

Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Όπως περιγράφω και στο θέμα θέλω η βάση να λειτουργεί (ανοίγει) για συγκεκριμένο αριθμό ημερών...
Φτιάχνω λοιπόν ένα πίνακα "tbldays" με πεδίο "firstdate". Πρέπει λοιπόν στο άνοιγμα της βάσης να γίνεται ένας έλεγχος αν το πεδίο firstdate είναι null και αν είναι να πάρει τιμή date() (πρώτη εκτέλεση της βάσης), αν δεν είναι null να γίνεται μια σύγκριση με το Now() και αν η διαφορά τους είναι μεγαλύτερη από χ ημέρες να βγάζει ένα σχετικό msgbox και να μην ανοίγει η βάση, ενώ αν είναι μικρότερη να προχωρά κανονικά το άνοιγμα της βάσης..
Φτιάγνω λοιπόν την παρακάτω συνάρτηση

Κώδικας:

Public Function fTrialDays()

Dim StartDay As Date
 

   'Ελέγχει τον πίνακα

   If IsNull(DMax("[firstdate]", "tbldays")) Then

       DoCmd.SetWarnings False

       DoCmd.RunSQL "INSERT INTO tbldays VALUES ( Now())"

       DoCmd.SetWarnings True

       Exit Function

   Else

       StartDay = DMax("[firstdate]", "tbldays")

   End If
 

   'Ελεγχος για χ=15 μέρες

   If Now() > DateAdd("d", 15, StartDay) Then

       'Σχετικό μήνυμα και κλείσιμο της access

       MsgBox "Οι x μέρες πέρασαν.", , "Info.."

       DoCmd.Quit

   else

       DoCmd.openForm "frmMain"

   End If
 

End Function

Σε πρώτη φάση λοιπόν δείχνει να δουλεύει, αλλά κατά το τεστάρισμα, βλέπω ότι θα πρέπει μετά την πρώτη φορά που η διαφορά θα είναι μεγαλύτερη από το χ να μην ξαναγίνει ο έλεγχος έτσι αν αλλάξει το systemdate προς τα πίσω να μην "ξεγελιέται" ο κώδικας... Καταλαβαίνω ότι κάπου πρέπει να μπει και μια τιμη Ναι/Οχι που θα αλλάξει όταν γίνει μεγαλύτερη η διαφορά και θα του λέει να μην ξανακάνει έλεγχο. αλλά έχω κολλήσει...
Η όλη ιστορία γίνεται στο "πριν τη φόρτωση" μιας φόρμας logon που είναι και η εκκίνηση της βάσης..
Επίσης τώρα σκέφτομαι ότι θα ήταν καλύτερο να γίνεται στο "κλείσιμο" της φόρμας logon ελέγχοντας και αν ο χρήστης είναι απλός ή admin (έχω στον tblusers πεδίο Ναι/Οχι που το Ναι δείχνει τον admin user kai το Οχι τον απλο user) και αν είναι απλός να τσεκάρονται οι μέρες, αλλιώς ο admin να περνάει ελεύθερα...
Θα ήθελε κάποιος να μου κάνει πράξη (συμπληρώσει) στον κώδικα τα παραπάνω? Επιπλέον αν υπάρχει και κάποιο άλλο σκεφτικό που να κάνει αυτό που θέλω δε θα είχα αντίρρηση.. )
Ευχαριστώ

Re: Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Καλημέρα,

Λοιπόν να αναφέρω μία εισαγωγή στον κώδικα σου εφόσον προστεθεί στον πίνακα TblDays και ένα πεδίο Boolean που θα ονομάζεται Locked με Default τιμή = False. Τώρα γίνεται έλεγχος αν είναι False ώστε να τρέξει ο κώδικας. Μόλις η τρέχουσα ημερομηνία είναι πλέον των 15 ημερών τότε έχουμε Locked=True επομένως και κλειδώνει και την επόμενη φορά που ξανακαλέσουμε τον κώδικα δεν γίνεται έλεγχος για πλέον των 15 ημερών απλά βγάζει το μήνυμα κλεισίματος καθότι το Locked είναι True.

Κώδικας:

if Dlookup("Locked","Tbldays")=false then

'Ελεγχος για χ=15 μέρες

     If Now() > DateAdd("d", 15, StartDay) Then

          Docmd.RunSql("UPDATE TblDays SET Locked=true")

          'Σχετικό μήνυμα και κλείσιμο της access

          MsgBox "Οι x μέρες πέρασαν.", , "Info.."

      end if

else

     'Σχετικό μήνυμα και κλείσιμο της access

     MsgBox "Οι x μέρες πέρασαν.", , "Info.."

end if

Φιλικά

iliadisk / kon73

Re: Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Ευχαριστώ πάρα πολύ για την άμεση και λειτουργική απάντηση...
Παραθέτω τον κώδικα όπως τελικά διαμορφώθηκε, για κάθε χρήση...
Μήπως υπάρχει και κάποια σκέψη που να μπει ένα ακόμα if (ίσως με Dlookup στον tblUsers πεδίο UserName ?) που να παρακάμπτει τελείως τον έλεγχο ημερών για τον χρήστη "admin"?

Κώδικας:

Public Function fTrailTest()

Dim dStartDay As Date

'Ελέγχει τον πίνακα

If IsNull(DMax("[FirstDate]", "tblDays")) Then

    DoCmd.SetWarnings False

    DoCmd.RunSQL "INSERT INTO tblDays VALUES ( Now(),False)"

    DoCmd.SetWarnings True

    Exit Function

Else

    dStartDay = DMax("[FirstDate]", "tblDays")

End If

' Έλεγχος run Code

If DLookup("Locked", "tblDays") = False Then

    ''Ελεγχος για χ=15 μέρες

    If Now() > DateAdd("d", 15, dStartDay) Then

        DoCmd.SetWarnings False

        DoCmd.RunSQL ("UPDATE tblDays SET Locked=true")

        DoCmd.SetWarnings True

        'Σχετικό μήνυμα και κλείσιμο της access

        MsgBox " Οι x μέρες πέρασαν.", , "Info.."

        DoCmd.Quit

    End If

    'Σχετικό μήνυμα

    MsgBox "Έχεις ακόμα μέρες.", , "Info.."

    DoCmd.OpenForm "frmLalala", acNormal

Else

    MsgBox " Οι x μέρες πέρασαν.", , "Info.."

    DoCmd.Quit

End If

End Function

(Ελπίζω να μην κάνω κατάχρηση της όρεξής σου για βοήθεια)
Thanks

Re: Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Καλημέρα,

Μπορείς να βάλεις στον πίνακα users ένα ακόμα πεδίο boolean το οποίο να ονομάζεται BlnTrialPass και να ελέγχει με Dlookup αν είναι true τότε να επιτρέπεται στον χρήστη αυτόν να ανοίγει την βάση ακόμα και αν έχει περάσει η δοκιμαστική περίοδο των 30 ημερών.

Αυτό το if BlnTrialPass=false θα είναι το πρώτο και στην αρχή του κώδικά σου και το end if θα κλείνει στο τέλος του κώδικά σου.

Φιλικά

iliadisk / kon73

Re: Κώδικας για να λειτουργεί η Βάση για συγκεκριμένες μέρες

Ευχαριστώ για όλα...
(Το έκανα το BlnTrialPass με μια άλλη ψευδοφορμα και όλα ΟΚ...)