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ä?
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!!
eikusiis toisinpäin, eli jos käyttäjä vastaa Jatketaanko?-kymysykseen Ok, niin silloin oli siis tarkoitus kai jatkaa ohjelman suoritusta eikä lopettaa... :/ kai:)
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...
Aihe on jo aika vanha, joten et voi enää vastata siihen.