Visual Basic 6 - Scadenza settimanale

Vorrei implementare il mio programma gestionale della palestra, inserendo un controllo che ogni settimana(o mese..) mi crei un file(di qualsiasi tipo) con all'interno i nomi della gente alla quale scadrà l'abbonamento in quella settimana.

Vi ricordo che l'archivio che contiene tutti i nomi e le date di scadenza è un file access.

mi date una mano nel codice???

vediamolo il codice, poi possiamo darti una mano... oppure vuoi pronto anche quello?

Ecco il codice...non fateci caso...è abbastanza incasinato...

Option Explicit
Dim flag As Integer
Dim mblnBrow As Boolean
Dim mintClear As Integer
Dim mintFind As Integer
Dim mblnCheck As Boolean
Dim mdatGExp As Date
Dim mdatTExp As Date
Dim mdatOD As Date
Dim mintOD As Integer
Dim mblnExpOD As Boolean
Dim a As Single
Dim b As Single
Dim c As Single




Private Sub cmdBrowse_Click()
    If mblnBrow = True Then Form_Load
End Sub





Private Sub cmdExp_Click()
    If mblnExpOD = True Then Form_Load
   
    mrstGym.MoveFirst
    Do Until mrstGym.EOF
        If mrstGym!fldGExp = True Or mrstGym!fldTExp = True Then
            mblnBrow = True
            Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers WHERE fldGExp = true  or fldTExp=true ORDER BY fldMemberID")
            ShowRecord
            mintFind = 0
            mblnExpOD = True
        Exit Sub
        Else
            mrstGym.MoveNext
        End If
    Loop
    MsgBox "Non ci sono clienti scaduti!!!", vbOKOnly + vbInformation
    Form_Load
End Sub

Private Sub cmdFind_Click()
    mintClear = 1
    mintFind = 1
    txtId.SetFocus
    ClearRecord
    Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers ORDER BY fldMemberID")
End Sub





Private Sub cmdUpdate_Click()
        WriteRecord
        mrstGym.Update
a = txtAmountdue.Text
b = txtInstall.Text
lblBalance.Caption = a - b
   
End Sub

Private Sub cmdEnter_Click()
    mrstGym.AddNew
    ClearRecord
    txtLastName.SetFocus
    flag = 1
End Sub

Private Sub cmdFirst_Click()
    mrstGym.MoveFirst
    ShowRecord
End Sub

Private Sub cmdLast_Click()
    mrstGym.MoveLast
    ShowRecord
End Sub



Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub cmdNext_Click()
    mrstGym.MoveNext
    If mrstGym.EOF Then mrstGym.MoveLast
    ShowRecord
End Sub

Private Sub cmdPrev_Click()
    mrstGym.MovePrevious
    If mrstGym.BOF Then mrstGym.MoveFirst
    ShowRecord
End Sub

Private Sub Command1_Click()
 Dim i As Long
    
    frmGym.Top = (Screen.Height / 2) - (Me.Height / 2)
    frmGym.Left = (Screen.Width / 2) - (Me.Width / 2)

    For i = frmGym.Left To (Screen.Width / 2) Step 10
        frmGym.Height = Me.Height - 15
        frmGym.Left = Me.Left + 100
        DoEvents
    Next
    
    Unload Me

End Sub

Private Sub Form_Load()
    Set pdbMembers = OpenDatabase(App.Path & "\Gym_Members.mdb")
    Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers ORDER BY fldMemberID")
    mblnBrow = False
    cmdFirst_Click
End Sub

Public Sub ShowRecord()
    With mrstGym
        txtId = !fldMemberID
        txtLastName = !fldLastName
        txtFirstName = !fldFirstName
        If !fldGender = "M" Then optM = True
        If !fldGender = "F" Then optF = True
        If !fldMemberShip = "Gym" Then optGym = True
        If !fldMemberShip = "Tanning" Then optTanning = True
        If !fldMemberShip = "Gym & Tanning" Then optGym_Tanning = True
        
        If !fldGymEx <> "" Then
            mdatGExp = !fldGymEx
            If mdatGExp < Date Then
                .Edit
                !fldGExp = True
                .Update
                
                txtEx_gym.Width = 975
                txtEx_gym.ForeColor = vbBlack
                txtEx_gym = !fldGymEx
            Else
                .Edit
                !fldGExp = False
                .Update
                
                txtEx_gym.Width = 1695
                txtEx_gym.ForeColor = vbBlack
                txtEx_gym = !fldGymEx
            End If
        Else
            .Edit
            !fldGExp = False
            .Update
            
            txtEx_gym.Width = 1695
            txtEx_gym = ""
        End If
        
     
        
        If !fldTanEx <> "" Then
            mdatTExp = !fldTanEx
            If mdatTExp < Date Then
                .Edit
                !fldTExp = True
                .Update
                
                txtEx_tan.Width = 975
                txtEx_tan.ForeColor = vbBlack
        
                txtEx_tan = !fldTanEx
            Else
                .Edit
                !fldTExp = False
                .Update
                
            
                txtEx_tan.Width = 1695
                txtEx_tan.ForeColor = vbBlack
                txtEx_tan = !fldTanEx
            End If
        Else
            .Edit
            !fldTExp = False
            .Update
           
            txtEx_tan.Width = 1695
            txtEx_tan = ""
        End If
        
        
        txtStreet = !fldStreet
        txtCity = !fldCity
        txtPhone = !fldPhoneNumber
       
        
        If !fldPayDue <> "" Then
            txtPayduedate = !fldPayDue
            mdatOD = !fldPayDue
            mintOD = Date - mdatOD
            If mintOD > 0 Then
                
                .Edit
                !fldOD = True
                .Update
            Else
                
                .Edit
                !fldOD = False
                .Update
            End If
        Else
            txtPayduedate = ""
            
            .Edit
            !fldOD = False
            .Update
        End If
        
        txtAmountdue = Format(!fldAmountDue, "Currency")
        txtInstall = Format(!fldInstallAmount, "Currency")
        lblBalance = Format(!fldBalance, "Currency")
        If !fldNotes <> "" Then txtNotes = !fldNotes Else txtNotes = ""
    End With
End Sub

Public Sub ClearRecord()

    If mintClear = 1 Then
        txtId = ""
        mintClear = 0
    Else
        txtId = mrstGym!fldMemberID
    End If
    txtLastName = ""
    txtFirstName = ""
    optM.Value = False
    optM.TabStop = True
    optF.Value = False
       optGym.Value = False
    optGym.TabStop = True
    optTanning.Value = False
    optGym_Tanning.Value = False
    txtEx_gym = ""
    
    txtEx_tan = ""
    
    txtStreet = ""
    txtCity = ""
    txtZip = ""
    
    txtPhone = ""
        
    txtPayduedate = ""
    txtAmountdue = ""
    txtInstall = ""
    lblBalance = Format(0, "Currency")
    txtNotes = ""
    
    txtEx_gym.Width = 1695
 
    txtEx_tan.Width = 1695
   
End Sub

Public Sub WriteRecord()
    With mrstGym
        If flag = 1 Then
            !fldMemberID = txtId
            flag = 0
        Else
            .Edit
        End If
        !fldLastName = txtLastName
        !fldFirstName = txtFirstName
        If optM = True Then !fldGender = "M"
        If optF = True Then !fldGender = "F"
    
        If optGym = True Then !fldMemberShip = "Gym"
        If optTanning = True Then !fldMemberShip = "Tanning"
        If optGym_Tanning = True Then !fldMemberShip = "Gym & Tanning"
        If txtEx_gym <> "" Then !fldGymEx = txtEx_gym Else !fldGymEx = Null
                If txtEx_tan <> "" Then !fldTanEx = txtEx_tan Else !fldTanEx = Null
                !fldStreet = txtStreet
        !fldCity = txtCity
        !fldPhoneNumber = txtPhone
        If txtPayduedate <> "" Then !fldPayDue = txtPayduedate Else !fldPayDue = Null
        If txtAmountdue <> "" Then !fldAmountDue = txtAmountdue Else !fldAmountDue = "0"
        If txtInstall <> "" Then !fldInstallAmount = txtInstall Else !fldInstallAmount = "0"
        !fldBalance = lblBalance
        If txtNotes <> "" Then !fldNotes = txtNotes Else !fldNotes = ""
    End With
End Sub



Private Sub txtId_KeyPress(KeyAscii As Integer)
    If mintFind = 1 Then
        If KeyAscii = 13 Then
            mrstGym.MoveFirst
            Do Until mrstGym.EOF
                If txtId = mrstGym!fldMemberID Then
                    ShowRecord
                    mintFind = 0
                Exit Sub
                Else
                    mrstGym.MoveNext
                End If
            Loop
            MsgBox "Cliente Inesistente", vbOKOnly + vbInformation, "Errore!"
            txtId.SelStart = 0
            txtId.SelLength = Len(txtId)
        End If
    End If
End Sub

Private Sub txtLastName_KeyPress(KeyAscii As Integer)
    If mintFind = 1 Then
        If KeyAscii = 13 Then
            mrstGym.MoveFirst
            Do Until mrstGym.EOF
                If txtLastName = mrstGym!fldLastName Then
                    mblnBrow = True
                    Set mrstGym = pdbMembers.OpenRecordset("SELECT * FROM tblMembers WHERE fldLastName = '" & txtLastName & "' ORDER BY fldMemberID")
                    ShowRecord
                    mintFind = 0
                Exit Sub
                Else
                    mrstGym.MoveNext
                End If
            Loop
            MsgBox "Il Cliente non esiste", vbOKOnly + vbInformation, "Inserimento errato"
            txtLastName.SelStart = 0
            txtLastName.SelLength = Len(txtLastName)
        End If
    End If
End Sub

cos'è che non funziona?

Funziona tutto...è che voglio aggiungere un controllo della scadenza settimanale dei clienti...
Che una volta premuto il command(definito da me) mi analizzi il contenuto del database, e se trova degli utenti che scadono in settimana/mese me ne visualizza il nome o la scheda...

Mi serve una mano...

sei consapevole che stai chiedendo del codice già pronto? è una politica del forum non rispondere a queste richieste in quanto violano il regolamento.

Eticamente può essere sbagliato, evidentemente se ci sarei riuscito non ve lo chiederei attualmente...
Confido in Voi

Salve,
se davvero ci hai gia' provato, perche' non posti il/i tuoi tentativi, avendo cura di inserire qualche commento (dove e' opportuno) e di dire cosa non funziona, perche' non funziona, e come dovrebbe (secondo te) funzionare;
vedrai che i consigli da parte nostra non tarderanno ad arrivare.
Per ora e' tutto, buone feste.

Luigi