Keskustelu: Ohjelmointikysymykset: VB6: Accessin hallinta Visual Basicilla

Tietojenkäsittelijäkö [20.04.2004 14:58:03]

Moi!
Voiskohan kokeneemmat auttaa? Mullon olemassa elokuvien selailutietokanta Accessilla, mutta nyt se pitäs saada muutettua sellaseks,että sitä vois hallita Visual Basicilla. Alkuun oon päässy, mutta sitten tyssäsi. Voisin laittaa koodin tähän näin, jos joku viisaampi osais sanoa, mikä mättää ?

Moduuliosa:

Option Explicit

Public adoConnection As ADODB.Connection
Public rstVideot As New ADODB.Recordset
Public rstGenret As New ADODB.Recordset
Public rstOhjaajat As New ADODB.Recordset
Public rstIkaraja As New ADODB.Recordset
Public rstHaku As New ADODB.Recordset
Public connectString As String

Sub main()
On Error GoTo virhe

Set adoConnection = New ADODB.Connection
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "data source=C:\Program files\Visual Basic 6.0\Videokanta.mdb"

adoConnection.Open connectString

rstVideot.Open "TblVideoVB", adoConnection, adOpenDynamic, adLockOptimistic, adCmdTable
rstOhjaajat.Open "TblOhjaajaVB", adoConnection, adOpenStatic, adLockOptimistic, adCmdTable
rstGenret.Open "TblGenreVB", adoConnection, adOpenStatic, adLockOptimistic, adCmdTable
rstIkaraja.Open "TblIkarajaVB", adoConnection, adOpenStatic, adLockOptimistic, adCmdTable

Do While Not rstOhjaajat.EOF
frmYllapito!cboOhjaajat.AddItem rstOhjaajat("Ohjaaja")
rstOhjaajat.MoveNext
Loop

Do While Not rstGenret.EOF
frmYllapito!cboGenret.AddItem rstGenret("Genre")
rstGenret.MoveNext
Loop

paivitaNaytto
taytaHakuCombo
frmYllapito.Show
Exit Sub
virhe:
MsgBox "Järjestelmän alkutoimissa ilmeni virhe."
RetValue = MsgBox("Jatketaanko?", vbOKCancel) 'Kysytään käyttäjältä jatketaanko vai peruutetaanko
End
End Sub

Public Sub paivitaNaytto()
Dim strOikeaGenre As String 'genren nimi
Dim strOikeaOhjaaja As String 'ohjaajan nimi
Dim strOikeaNimi As String 'videon nimi
Dim i As Integer

frmYllapito!txtVideo_ID.Text = rstVideot("VIDEO_ID") 'vaiko jotenkin numeroksi???
frmYllapito!txtNimi.Text = rstVideot("Nimi")
frmYllapito!txtValmistusvuosi.Text = rstVideot("Valmistusvuosi")
frmYllapito!txtPaaosat.Text = rstVideot("Paaosat")
frmYllapito!txtKesto.Text = rstVideot("Kesto") 'vaiko jotenkin numeroksi???
frmYllapito!txtAlkuper_nimi.Text = rstVideot("Alkuper_nimi")
frmYllapito!txtKuva.Text = rstVideot("Kuva") 'vaiko jotenkin bitmapiksi??
strOikeaGenre = haeGenre(rstVideot("GENRE_ID"))
For i = 0 To frmYllapito!cboGenret.ListCount - 1
    If strOikeaGenre = frmYllapito!cboGenret.List(i) Then
    frmYllapito!cboGenret.ListIndex = i
    End If
Next
strOikeaOhjaaja = haeOhjaaja(rstVideot("VIDEO_ID"))
For i = 0 To frmYllapito!cboOhjaajat.ListCount - 1
    If strOikeaOhjaaja = frmYllapito!cboOhjaajat.List(i) Then
    frmYllapito!cboOhjaajat.ListIndex = i
    End If
Next
'pitäskö tähän vielä jotenkin videoista satuilla?
'tutkitaan ovatko siirtymiset sallittuja
frmYllapito.cmdEdellinen.Enabled = True
frmYllapito.cmdEnsimmaiseen.Enabled = True
frmYllapito.cmdSeuraava.Enabled = True
frmYllapito.cmdViimeiseen.Enabled = True
rstVideot.MoveNext

If rstVideot.EOF Then
    frmYllapito.cmdSeuraava.Enabled = False
    rstVideot.MoveLast
    Else
    rstVideot.MovePrevious
End If
'nyt tutkitaan voidaanko siirtyä taaksepäin
rstVideot.MovePrevious
If rstVideot.BOF Then
    frmYllapito.cmdEdellinen.Enabled = False
    rstVideot.MoveFirst
    Else
    rstVideot.MoveNext
End If
End Sub

Function haeGenre(intGenreid As Integer) As String
Dim strEhto As String
strEhto = "GENRE_ID= " & intGenreid
rstGenret.MoveFirst
rstGenret.Find strEhto
If rstGenret.EOF Then
    MsgBox "Hakemaasi genreä ei löytynyt."
Else
    haeGenre = rstGenret("Genre")
End If
End Function

Function haeOhjaaja(intOhjaajaid As Integer) As String
Dim strEhto As String
strEhto = "OHJAAJA_ID=" & intOhjaajaid
rstOhjaajat.MoveFirst
rstOhjaajat.Find strEhto
If rstGenret.EOF Then
    MsgBox "Hakemaasi tietoa ei löytynyt."
Else
    haeOhjaaja = rstOhjaajat("Ohjaaja")
End If
End Function

Public Sub taytaHakuCombo()
rstHaku.Open "select VIDEO_ID, Nimi from tblVideoVB", adoConnection, adOpenDynamic, adLockOptimistic, _
adCmdText
frmHaku!cboValinta.Clear
Do While Not rstHaku.EOF
    frmHaku!cboValinta.AddItem rstHaku("Nimi")
    rstHaku.MoveNext
Loop
rstHaku.Close
Set rstHaku = Nothing

End Sub
End Sub

Formi menee näin:

Private Sub cmdLisaa_Click()
    txtVideo_ID.Text = ""
    txtNimi.Text = ""
    cboOhjaajat.ListIndex = -1
    cboGenret.ListIndex = -1
    txtKesto.Text = ""
    txtPaaosat.Text = ""
    txtValmistusvuosi.Text = ""
    txtIkaraja.Text = ""
    cmdEnsimmaiseen.Enabled = False
    cmdEdellinen.Enabled = False
    cmdSeuraava.Enabled = False
    cmdViimeiseen.Enabled = False
    cmdPoista.Enabled = False
    cmdHaku.Enabled = False
    cmdTheEnd.Caption = "Peruuta"
    cmadPaivita.Caption = "Tallenna"
End Sub

Private Sub cmdPaivita_Click()
    If tarkasta = False Then
        MsgBox "Jätit jonkin kentän tyhjäks, korjaisitko?", vbCritical, "Päivitysvirhe"
    Else
        If cmdPaivita.Caption = "Tallenna" Then
        rstVideot.Find "Video_ID" & txtVideo_ID.Text
            If rstVideot.EOF Then
            'lisäys sallitaan
                rstVideot.AddNew
                rstVideot("VIDEO_ID") = txtVideo_ID.Text
                rstVideot("Nimi") = txtNimi.Text
                rstVideot("Valmistusvuosi") = txtValmistusvuosi.Text
                rstVideot("Paaosat") = txtPaaosat.Text
                rstVideot("Kesto") = txtKesto.Text
                rstVideot("Alkuper_nimi") = txtAlkperNimi.Text
                rstVideot("Kuva") = txtKuva.Text
                rstVideot("GENRE_ID") = haeGENRE_ID(cboGenret.Text)
                rstVideot("OHJAAJA_ID") = haeOHJAAJA_ID(cboOhjaajat.Text)
                rstVideot.Update
    'jokin lause
            cmdLisaa.Enabled = True
            cmdPoista.Enabled = True
            paivitaNaytto
            cmdLopeta.Caption = "The End"
            cmdPaivita.Caption = "Saata tiedot ajan tasalle."
        Else
            MsgBox "Numero on jo käytössä, vaihda numero", vbInformation
            txtVideo_ID.SetFocus
            txtVideoID.SelStart = 0
            txtVideoID.SelLength = Len(txtVideoID.Text)
        End If
    Else ' halutaan muuttaa tietoja mieluummin aliohjelmalla
                rstVideot("VIDEO_ID") = txtVideo_ID.Text
                rstVideot("Nimi") = txtNimi.Text
                rstVideot("Valmistusvuosi") = txtValmistusvuosi.Text
                rstVideot("Paaosat") = txtPaaosat.Text
                rstVideot("Kesto") = txtKesto.Text
                rstVideot("Alkuper_nimi") = txtAlkperNimi.Text
                rstVideot("GENRE_ID") = haeGENRE_ID(cboGenret.Text)
                rstVideot("OHJAAJA_ID") = haeOHJAAJA_ID(cboOhjaajat.Text)
                rstVideot.Update
    taytaHakuCombo
    End If
End If
End Sub

Private Sub cmdPoista_Click()
Dim intPaluu As Integer

intPaluu = MsgBox("Haluatko poistaa tiedot?", vbYesNo, "Vahvistetaan poisto")
If intPaluu = vbYes Then
    rstVideot.Delete
    rstVideot.MoveFirst 'poiston jälkeenhän on siirryttävä jonnekkin
    paivitaNaytto
    taytaHakuCombo
Else
    MsgBox "Poisto peruttu.", vbInformation, "Poiston peruutus"
End If
End Sub

Private Sub cmdTheEnd_Click()
    If cmdTheEnd.Caption = "The End" Then
        rstPaaosat.Close
        rstVideot.Close
        Set rstPaaosat = Nothing
        Set rstVideot = Nothing
        adoConnection.Close
        End
    Else
        paivitaNaytto
        cmdHaku.Enabled = True
        cmdViimeiseen.Enabled = True
        cmdPoista.Enabled = True
        cmdTheEnd.Caption = "The End"
        cmdPaivita.Caption = "Paivita"
    End If
End Sub

Private Sub cmdEdelliseen_Click()
    rstVideot.MovePrevious
    paivitaNaytto
End Sub

Private Sub cmdEnsimmaiseen_Click()
    rstVideot.MoveFirst
    paivitaNaytto
End Sub

Private Sub cmdSeuraavaan_Click()
    rstVideot.MoveNext
    paivitaNaytto
End Sub

Private Sub cmdHaku_Click()
    If frmHaku.cboValinta.ListCount = 0 Then
        taytaHakuCombo
    End If
frmHaku.Show
frmHaku.cboValinta.SetFocus
End Sub

Private Sub cmdViimeiseen_Click()
    rstVideot.MoveLast
    paivitaNaytto
End Sub

Private Function tarkasta() As Boolean
Dim Ok As Boolean
Ok = True
If txtVideo_ID.Text = "" Then
    Ok = False
End If
If txtNimi.Text = "" Then
    Ok = False
End If
If txtValmistusvuosi.Text = "" Then
    Ok = False
End If
If txtAlkuper_nimi.Text = "" Then
    Ok = False
End If
If cboOhjaajat.ListIndex = -1 Then
    Ok = False
End If
If cboGenret.ListIndex = -1 Then
    Ok = False
End If
If txtKesto.Text = "" Then
    Ok = False
End If
If txtPaaosat.Text = "" Then
    Ok = False
End If
tarkasta = Ok
End Function
Private Function haeGENRE_ID(strGenret As String) As Integer

rstGenret.MoveFirst
rstGenret.Find "Genre='" & strGenret & " '"
haeGENRE_ID = rstGenret("GENRE_ID")

End Function

Private Function haeOHJAAJA_ID(strOhjaajat As String) As Integer

rstOhjaajat.MoveFirst
rstOhjaajat.Find "Ohjaaja='" & strOhjaajat & " '"
haeOHJAAJA_ID = rstOhjaajat("OHJAAJA_ID")

End Function

End Sub

Private Sub mnuLopeta_Click()
    Unload Me
End Sub

Virhe tulee jossain RetValue-kohdassa, ilmeisesti se pitäis esitellä jossain, mut ku en kuollaksenikaan muista missä?

SannaK [20.04.2004 17:52:31]

Niin, tuolla Sub-mainin virheenkäsittelyosassahan tuommoinen esittelemätön RetValue näyttäisi olevan. En muista vb6:sen kaikkia hienouksia :> mutta koska palan halusta yrittää auttaa, niin kokeileppa jos tekisit sen (jotenkin) näin:

virhe:
Dim RetValue As MsgBoxResult (tai mikä siellä nyt onkaan vaihtoehtona)

MsgBox "Järjestelmän alkutoimissa ilmeni virhe."
RetValue = MsgBox("Jatketaanko?", vbOKCancel) 'Kysytään käyttäjältä jatketaanko vai peruutetaanko

IF Result = vbOK then
End
ELSE
Resume Next

(Resume Next muistaakseni jatkaa ohjelman suoritusta virheen aiheuttaneen kohdan seuraavasta kohdasta, niitä on muitakin vaihtoehtoja, joista voi valita sopivimman tuohon kohtaan)

Toivottavasti olisi edes yhtään apua!!

SannaK [20.04.2004 17:54:34]

eikusiis toisinpäin, eli jos käyttäjä vastaa Jatketaanko?-kymysykseen Ok, niin silloin oli siis tarkoitus kai jatkaa ohjelman suoritusta eikä lopettaa... :/ kai:)

Tietojenkäsittelijäkö [30.04.2004 08:32:59]

Moron!
Muuttelin vähän tota alkuperäistä hommelia.Nyt siin ei oo kuvia, koska sekin oli hieman tuskan takana se homma, ja virheenkäsittely on tällanen:

virhe:
MsgBox Err.Number & ":" & Err.Source & ":" & Err.Description
End

Mut edelleen jokin tökkii ja pahasti. Päivitys toimisi ja poisto toimisi,selailu ja haku-ja lisäystoiminnot vaan tökkivät. Huutavat että "object required" ja kun en ollenkaan nyt pääse etiäpäin...

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku