[VB6] Leggere archivio di record in Access

**Magicolotto** · 06-10-2005, 07:30

Ciao a tutti vorrei se possibile un aiuto su un progetto....

Vi spiego ho creato un form in esso vengono visualizzati i dati posti su un archivio access,vengono visualizzati in delle caselle di testo ( textbox) i dati visualizzati per ogni records dell'archivio vanno da 0 a 51, txtFields(0)------>txtFields(51)

vorrei creare delle matrici , variabili per fare una ricerca ogni qual volta si scorre l'archivio per records, ma haime' nn ci sto riuscendo, chiedo gentilmente un aiuto....
se volete vi posto tutto il code
anzi lo posto

codice:

Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub Form_Load()
  Dim db As Connection
  Set db = New Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=archivio.mdb;"

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select ID,Data,BA1,BA2,BA3,BA4,BA5,CA1,CA2,CA3,CA4,CA5,FI1,FI2,FI3,FI4,FI5,GE1,GE2,GE3,GE4,GE5,MI1,MI2,MI3,MI4,MI5,NA1,NA2,NA3,NA4,NA5,PA1,PA2,PA3,PA4,PA5,RO1,RO2,RO3,RO4,RO5,TO1,TO2,TO3,TO4,TO5,VE1,VE2,VE3,VE4,VE5 from archivio", db, adOpenStatic, adLockOptimistic

  Dim oText As TextBox
  'Associa le caselle di testo al fornitore di dati
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next

  mbDataChanged = False
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  lblStatus.Width = Me.Width - 1500
  cmdNext.Left = lblStatus.Width + 700
  cmdLast.Left = cmdNext.Left + 340
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If mbEditFlag Or mbAddNewFlag Then Exit Sub

  Select Case KeyCode
    Case vbKeyEscape
      cmdClose_Click
    Case vbKeyEnd
      cmdLast_Click
    Case vbKeyHome
      cmdFirst_Click
    Case vbKeyUp, vbKeyPageUp
      If Shift = vbCtrlMask Then
        cmdFirst_Click
      Else
        cmdPrevious_Click
      End If
    Case vbKeyDown, vbKeyPageDown
      If Shift = vbCtrlMask Then
        cmdLast_Click
      Else
        cmdNext_Click
      End If
  End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'Visualizza la posizione del record corrente per questo gruppo di record
  lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'Posizione in cui inserire il codice per la convalida
  'L'evento viene richiamato in seguito alle seguenti azioni
  Dim bCancel As Boolean

  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
    lblStatus.Caption = "Aggiunge il record"
    mbAddNewFlag = True
    SetButtons False
  End With

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdRefresh_Click()
  'Necessario solo per applicazioni multiutente
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr

  lblStatus.Caption = "Modifica il record"
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
  On Error Resume Next

  SetButtons True
  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate
  If mvBookMark > 0 Then
    adoPrimaryRS.Bookmark = mvBookMark
  Else
    adoPrimaryRS.MoveFirst
  End If
  mbDataChanged = False

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  adoPrimaryRS.UpdateBatch adAffectAll

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'si sposta sul nuovo record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  mbDataChanged = False

  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdFirst_Click()
  On Error GoTo GoFirstError

  adoPrimaryRS.MoveFirst
  mbDataChanged = False

  Exit Sub

GoFirstError:
  MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
  On Error GoTo GoLastError

  adoPrimaryRS.MoveLast
  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
  On Error GoTo GoNextError

  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     'è stata superata la fine e quindi torna indietro
    adoPrimaryRS.MoveLast
  End If
  'visualizza il record corrente
  mbDataChanged = False

  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
  On Error GoTo GoPrevError

  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    'è stata superata la fine e quindi torna indietro
    adoPrimaryRS.MoveFirst
  End If
  'visualizza il record corrente
  mbDataChanged = False

  Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  cmdNext.Enabled = bVal
  cmdFirst.Enabled = bVal
  cmdLast.Enabled = bVal
  cmdPrevious.Enabled = bVal
End Sub

**alka** · 06-10-2005, 09:41

Di quale versione di Visual Basic stiamo parlando?

E' obbligatorio indicarlo nel titolo come da Regolamento.

Scrivimi questa informazione così posso correggerlo io.

Ciao!

**Magicolotto** · 06-10-2005, 13:11

ciaoscusa

hai ragione
VISULBASIC 6

aspetto con ansia vostri graditissimi suggerimenti

**Magicolotto** · 06-10-2005, 22:50

lo porto su educatamente , sperando in un vostro aiuto

**mgmg** · 07-10-2005, 09:47

Prova eventualmente così:
Dim oText As Field
Set adoPrimaryRS = New Recordset
'Con questa select stai leggendo tutti i record presenti nella tabella archivio:
adoPrimaryRS.CursorLocation = adUseClient
adoPrimaryRS.Open "select ID,Data,BA1,BA2,BA3,BA4,BA5,CA1,CA2,CA3,
CA4,CA5,FI1,FI2,FI3,FI4,FI5,GE1,GE2,GE3,
GE4,GE5,MI1,MI2,MI3,MI4,MI5,NA1,NA2,NA3,
NA4,NA5,PA1,PA2,PA3,PA4,PA5,RO1,RO2,RO3,
RO4,RO5,TO1,TO2,TO3,TO4,TO5,VE1,VE2,VE3,
VE4,VE5 from archivio", db, adOpenStatic, adLockOptimistic

'qui devi testare se adoPrimaryRS.eof altrimenti errore se eof

If Not(adoPrimaryRS.eof) then

' qui devi associare il primo record della tabella alle caselle di testo.
i= 0
For Each oText In adoPrimaryRS.Fields
TxtFields(i) = adoPrimaryRS(i)
i = i + 1
Next
end if

**Magicolotto** · 07-10-2005, 21:16

ma hai rreiscritto quelloche ho postato io nel code???

**mgmg** · 07-10-2005, 21:30

Questo nel tuo codice non c'è:
adoPrimaryRS.CursorLocation = adUseClient

Questo nel tuo codice non c'è e ti serve perchè se fai eof e leggi i valori dei campi del record va in errore

If Not(adoPrimaryRS.eof) then

E QUESTO

Dim oText As Field
i= 0
For Each oText In adoPrimaryRS.Fields
TxtFields(i) = adoPrimaryRS(i)
i = i + 1
Next
End if

NON MI SEMBRA UGUALE A QUESTO

Dim oText As TextBox
'Associa le caselle di testo al fornitore di dati
For Each oText In Me.txtFields
Set oText.DataSource = adoPrimaryRS
Next
Utilizzare i nomi delle variabili uguali non significa che il codice è uguale, perchè per associare i campi testi o usi un adodc oppure devi dire che il contenuto dei campi del record nell'ordine della selezione si spostano sui campi testo del form.

Ciao

**Magicolotto** · 07-10-2005, 21:43

Chiedo scusa ma sono alle prime armi, pero' VISUAL BASIC 6 è cosi bello che non riesco a rinunciarci,allora
per capirci meglio, allego un file dove cè il lavoro che ho fatto....grazie a tentissime guide...
nel file potete visualizzare l'oggetto

nell'oggetto che un command chiamato elabora

QUINDI QUANDO SI VISUALIZZA L'ARCHIVIO SOPRA IN ALTO
bisognerebbe cliccare ELABOR e far visualizzare i dati nella text chiamata Prv

quindiesempio di ricerca, sommare i cinque elementi visualizzati
field(1)----> field(5) e la oro somma visualizzarla nella text

vi allego una immaggine ed il NUOVO CODICE....
se poi è possibile fare la stessa cosa nel codice di sopra megio.....

VI PREGO AIUTATEMI A FARMI CAPIRE....
perche se capiro sarei soddisfatto di me e dela vostra pazienza

GRAZIEeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee

code :

codice:

Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub Form_Load()
  Dim db As Connection
  Set db = New Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=archivio.mdb;"

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select data,PO1,PO2,PO3,PO4,PO5 from nazionale1", db, adOpenStatic, adLockOptimistic

  Dim oText As TextBox
  Dim TextBox As Integer
 
   'Associa le caselle di testo al fornitore di dati
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next

  mbDataChanged = False

End Sub
  Private Sub Elabora_Click()
  Elabora = TextBox
  Elabora = Elabora + 1
   amb = Elabora + (Elabora + 1)
   If amb = 84 Then
   Label1.Caption = "" & Elabora
   End If
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  lblStatus.Width = Me.Width - 1500
  cmdNext.Left = lblStatus.Width + 700
  cmdLast.Left = cmdNext.Left + 340
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If mbEditFlag Or mbAddNewFlag Then Exit Sub

  Select Case KeyCode
    Case vbKeyEscape
      cmdClose_Click
    Case vbKeyEnd
      cmdLast_Click
    Case vbKeyHome
      cmdFirst_Click
    Case vbKeyUp, vbKeyPageUp
      If Shift = vbCtrlMask Then
        cmdFirst_Click
      Else
        cmdPrevious_Click
      End If
    Case vbKeyDown, vbKeyPageDown
      If Shift = vbCtrlMask Then
        cmdLast_Click
      Else
        cmdNext_Click
      End If
  End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'Visualizza la posizione del record corrente per questo gruppo di record
  lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'Posizione in cui inserire il codice per la convalida
  'L'evento viene richiamato in seguito alle seguenti azioni
  Dim bCancel As Boolean

  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
    lblStatus.Caption = "Aggiunge il record"
    mbAddNewFlag = True
    SetButtons False
  End With

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdRefresh_Click()
  'Necessario solo per applicazioni multiutente
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr

  lblStatus.Caption = "Modifica il record"
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
  On Error Resume Next

  SetButtons True
  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate
  If mvBookMark > 0 Then
    adoPrimaryRS.Bookmark = mvBookMark
  Else
    adoPrimaryRS.MoveFirst
  End If
  mbDataChanged = False

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  adoPrimaryRS.UpdateBatch adAffectAll

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'si sposta sul nuovo record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  mbDataChanged = False

  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdFirst_Click()
  On Error GoTo GoFirstError

  adoPrimaryRS.MoveFirst
  mbDataChanged = False

  Exit Sub

GoFirstError:
  MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
  On Error GoTo GoLastError

  adoPrimaryRS.MoveLast
  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
  On Error GoTo GoNextError

  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     'è stata superata la fine e quindi torna indietro
    adoPrimaryRS.MoveLast
  End If
  'visualizza il record corrente
  mbDataChanged = False

  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
  On Error GoTo GoPrevError

  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    'è stata superata la fine e quindi torna indietro
    adoPrimaryRS.MoveFirst
  End If
  'visualizza il record corrente
  mbDataChanged = False

  Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  cmdNext.Enabled = bVal
  cmdFirst.Enabled = bVal
  cmdLast.Enabled = bVal
  cmdPrevious.Enabled = bVal
End Sub

Private Sub OLE1_Updated(Code As Integer)

End Sub


Private Sub HScroll1_Change()

End Sub

immaggine :

**Magicolotto** · 09-10-2005, 11:32

non mi aiuta nessuno??

**Magicolotto** · 13-10-2005, 07:54

Discussione: [VB6] Leggere archivio di record in Access

Strumenti discussione

Ricerca discussione

Visualizza

come leggere archivio

Moderazione

Permessi di invio