Keskustelu: Koodit: VB6: Tietokantojen luonti (Access) ja hallinta koodista käsin

'Tekijä: Wizard 2004; FileExists funktio: Antti Laaksonen
'Tämä malli luo tietokannan kahdella taululla joista toisessa on asiakasrekisteritiedot sekä toisessa kaupunkien nimiä.
'Tietokannan perusteet kannattaa olla hallussa jotta ymmärtää toisen taulun idean mallissa.
'Muokkaamalla tätä mallia ja lisäämällä pieniä toimintoja, saadaan yksinkertainen toimiva asiakasrekisteri.
'Malli ei toimi aivan täydellisesti eikä ole "tehokas" ratkaisu, mutta toimii jotenkin ja on suuntaa antava
Dim strConnection As String
Dim tblKaupunki() As String
Dim tblAsiakas() As String
Dim intKaupunkiLkm As Integer
Dim intAsiakasLkm As Integer

Private Sub cmdLisaa_Click()

    TarkistaKentat

End Sub

Sub TarkistaKentat()

    'Koska tietokanta ei hyväksy kenttiin nolla-arvoja, niin tarkistetaan, että jokaisessa kentässä on jokin tieto.
    'Jos hyväksyt tietokannassa nolla-arvoja, niin joudut ottamaan tämän huomioon VB koodissa, koska VB kaatuu aina kun kentässä ei ole mitään arvoa eli null.
    'Kierrän tämän ongelma sillä, että vaadin jokaiseen kenttään tässä jonkin arvon.

    If txtAsiakasID.Text = "" Then
        MsgBox ("Anna asiakasnumero")
        txtAsiakasID.SetFocus
        GoTo Loppu
    ElseIf txtNimi.Text = "" Then
        MsgBox ("Anna nimi")
        txtNimi.SetFocus
        GoTo Loppu
    ElseIf txtOsoite.Text = "" Then
        MsgBox ("Anna osoite")
        txtOsoite.SetFocus
        GoTo Loppu
    ElseIf txtPonro.Text = "" Then
        MsgBox ("Anna postinumero")
        txtPonro.SetFocus
        GoTo Loppu
    ElseIf cboKaupunki.Text = "Valitse kaupunki" Then
        MsgBox ("Valitse kaupunki")
        cboKaupunki.SetFocus
        GoTo Loppu
    End If

    TallennaAsiakasrekisteri

Loppu:

End Sub

Sub PaivitaAsiakasrekisteri()

    Dim strKaupunkiID As Integer

    For i = 1 To intKaupunkiLkm
        If tblKaupunki(2, i) = cboKaupunki.Text Then
            strKaupunkiID = tblKaupunki(1, i)
            Exit For
        End If
    Next i

    AvaaYhteys

    Set adTietue = myYhteys.Execute("Update Asiakasrekisteri Set nimi = '" & txtNimi.Text & "', osoite = '" & txtOsoite.Text & "', ponro = '" & txtPonro.Text & "', kaupunkiID = '" & strKaupunkiID & "' where AsiakasID = " & txtAsiakasID.Text & "")

    SuljeYhteys

    MsgBox ("Tiedot päivitetty")

    LueTiedot

End Sub

Sub TallennaAsiakasrekisteri()

    Dim strKaupunkiID As Integer

    For i = 1 To intKaupunkiLkm
        If tblKaupunki(2, i) = cboKaupunki.Text Then
            strKaupunkiID = tblKaupunki(1, i)
            Exit For
        End If
    Next i

    'Avataan tietokantayhteys
    AvaaYhteys

    Set adTietue = myYhteys.Execute("insert into Asiakasrekisteri values('" & txtAsiakasID.Text & "', '" & txtNimi.Text & "', '" & txtOsoite.Text & "', '" & txtPonro.Text & "', '" & strKaupunkiID & "')")

    'Suljetaan tietokantayhteys
    SuljeYhteys

    MsgBox ("Tiedon lisätty ja tallennettu.")

    txtAsiakasID.Text = ""
    txtNimi.Text = ""
    txtOsoite.Text = ""
    txtPonro.Text = ""
    cboKaupunki.Text = "Valitse kaupunki"

    LueTiedot

End Sub

Sub LataaTiedot()

    ReDim tblKaupunki(2, 1)

    'Avataan tietokantayhteys
    AvaaYhteys

    Set adTietue = myYhteys.Execute("select KaupunkiID, Kaupunki from Kaupunki order by Kaupunki")

    i = 0
    Do While adTietue.EOF = False
        i = i + 1
        ReDim Preserve tblKaupunki(2, i)
        tblKaupunki(1, i) = adTietue("KaupunkiID")
        tblKaupunki(2, i) = adTietue("Kaupunki")
        cboKaupunki.AddItem adTietue("Kaupunki")
        adTietue.MoveNext
    Loop
    intKaupunkiLkm = i

    'Suljetaan tietokantayhteys
    SuljeYhteys

End Sub

Sub MuotoileGrid()

    'Muotoillaan flexgrid komponenttia sekä asetetaan / jätetään siihen vain otsikkorivi
    flexRekisteri.Clear

    With flexRekisteri
    .TextMatrix(0, 0) = "AsiakasID"
    .TextMatrix(0, 1) = "Nimi"
    .TextMatrix(0, 2) = "Osoite"
    .TextMatrix(0, 3) = "Ponro"
    .TextMatrix(0, 4) = "Kaupunki"
    .ColWidth(0) = 800
    .ColWidth(1) = 2000
    .ColWidth(2) = 2000
    .ColWidth(3) = 800
    .ColWidth(4) = 1500
    .CellAlignment = flexAlignLeftBottom
    End With

    flexRekisteri.Rows = 1

End Sub

Private Sub cmdLueTiedot_Click()

    LueTiedot

End Sub

Sub LueTiedot()

    MuotoileGrid

    Dim intHaku As Integer
    Dim strLisaarivi As String
    ReDim tblAsiakas(5, 1)


    'Avataan tietokantayhteys
    AvaaYhteys

    Set adTietue = myYhteys.Execute("select AsiakasID, Nimi, Osoite, Ponro, KaupunkiID from Asiakasrekisteri")

    'Haetaan asiakasrekisrin tiedot tietokannasta
    i = 0
    Do While adTietue.EOF = False
        i = i + 1
        ReDim Preserve tblAsiakas(5, i)
        tblAsiakas(1, i) = adTietue("AsiakasID")
        tblAsiakas(2, i) = adTietue("Nimi")
        tblAsiakas(3, i) = adTietue("Osoite")
        tblAsiakas(4, i) = adTietue("Ponro")
        tblAsiakas(5, i) = adTietue("KaupunkiID")
        adTietue.MoveNext
    Loop
    intAsiakasLkm = i

    'Suljetaan tietokantayhteys
    SuljeYhteys

    'Koska asiakasrekisterissä on vain kaupungin numero, niin haetaan numeroa vastaava nimi ja vaihdetaan nimi numeron paikalle
    For i = 1 To intAsiakasLkm
        intHaku = tblAsiakas(5, i)
        For j = 1 To intKaupunkiLkm
            If tblKaupunki(1, j) = intHaku Then
                tblAsiakas(5, i) = tblKaupunki(2, j)
                Exit For
            End If
        Next j
    Next i

    'Lisätään asiakas taulusta data flexgridiin
    For i = 1 To intAsiakasLkm
        strLisaarivi = tblAsiakas(1, i) & vbTab & tblAsiakas(2, i) & vbTab & tblAsiakas(3, i) & vbTab & tblAsiakas(4, i) & vbTab & tblAsiakas(5, i)
        flexRekisteri.AddItem strLisaarivi
    Next i

End Sub

Private Sub cmdLuoTietokanta_Click()

    'Testataan onko tietokanta jo olemassa
    If FileExists(App.Path & "Malli.mdb") = True Then
        MsgBox ("Tietokanta on jo olemassa")
        cmdLuoTietokanta.Enabled = False
        frmMalli.Enabled = True
        GoTo Loppu
    Else

    'Tietokannan nimi ja sijainti
    strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Malli.mdb"

    'Luodaan muuttujat
    Dim objCat As ADOX.Catalog
    Dim objAsiakasrekisteri As New ADOX.Table
    Dim objKaupunki As New ADOX.Table

    Set objCat = New ADOX.Catalog

    objCat.Create strConnection

    objCat.ActiveConnection = strConnection

    'Määritellään taulut
    With objAsiakasrekisteri
    .Name = "Asiakasrekisteri"
    Set .ParentCatalog = objCat
        With .Columns
            .Append "AsiakasID", adInteger
            .Append "Nimi", adVarWChar, 75
            .Append "Osoite", adVarWChar, 75
            .Append "Ponro", adVarWChar, 5
            .Append "KaupunkiID", adInteger
        End With
        .Keys.Append "AsiakasID", adKeyPrimary, "AsiakasID"
    End With

    With objKaupunki
    .Name = "Kaupunki"
    Set .ParentCatalog = objCat
        With .Columns
            .Append "KaupunkiID", adInteger
            .Append "Kaupunki", adVarWChar, 50
        End With
        .Keys.Append "KaupunkiID", adKeyPrimary, "KaupunkiID"
    End With

    'Luodaan taulut
    objCat.Tables.Append objAsiakasrekisteri
    objCat.Tables.Append objKaupunki

    Set objAsiakasrekisteri = Nothing
    Set objKaupunki = Nothing

    MsgBox ("Tietokanta luotu onnistuneesti.")

    'Lisätään data. Ennen datan lisäystä kannattaa olla pieni tauko, koska kone tarvitsee hieman aikaa luodakseen tietokannan levylle.
    'Jos alat liian nopeasti lisäämään dataa tietokantaan, niin osa datasta ei mene tietokantaan.
    'Käytän tässä vain yksinkertaista msgbox johon käyttäjä joutuu reagoimaan ja kone kerkiää luomaan tietokannan.

    LisaaData
    MsgBox ("Data lisätty onnistuneesti.")

    'Ladataan kaupunkien tiedot tietokannasta Comboboxiin
    LataaTiedot

    frmMalli.Enabled = True
    cmdLueTiedot.Enabled = True
    cmdLuoTietokanta.Enabled = False

    End If

Loppu:

End Sub

Sub LisaaData()

    'Avataan tietokantayhteys
    AvaaYhteys

    Set adTietue = myYhteys.Execute("insert into Kaupunki Values('1', 'Lappeenranta')")
    Set adTietue = myYhteys.Execute("insert into Kaupunki Values('2', 'Helsinki')")

    'Suljetaan tietokantayhteys
    SuljeYhteys

End Sub

Private Sub cmdPaivita_Click()

    PaivitaAsiakasrekisteri

End Sub

Private Sub cmdUusi_Click()

    cmdPaivita.Enabled = False
    cmdLisaa.Enabled = True

    'Avataan tietokantayhteys
    AvaaYhteys

    Set adTietue = myYhteys.Execute("select max(asiakasID) as SuurinAsiakasID from asiakasrekisteri")

    txtAsiakasID.Text = adTietue("SuurinAsiakasID") + 1
    'Suljetaan tietokantayhteys
    SuljeYhteys

    txtNimi.Text = ""
    txtOsoite.Text = ""
    txtPonro.Text = ""
    cboKaupunki.Text = "Valitse kaupunki"

End Sub

Private Sub flexRekisteri_DblClick()

    If flexRekisteri.Text = "AsiakasID" Then
        GoTo Loppu
    Else
        For i = 1 To intAsiakasLkm
            If tblAsiakas(1, i) = flexRekisteri.Text Then
                txtAsiakasID.Text = tblAsiakas(1, i)
                txtNimi.Text = tblAsiakas(2, i)
                txtOsoite.Text = tblAsiakas(3, i)
                txtPonro.Text = tblAsiakas(4, i)
                cboKaupunki.Text = tblAsiakas(5, i)
                Exit For
            End If
        Next i
    End If

    cmdLisaa.Enabled = False
    cmdPaivita.Enabled = True
    cmdUusi.Enabled = True

Loppu:

End Sub

Private Sub Form_Load()

    'Testataan onko tietokanta jo olemassa
    If FileExists(App.Path & "\Malli.mdb") = True Then
        frmMalli.Enabled = True
        cmdLuoTietokanta.Enabled = False
        LataaTiedot
    Else
        frmMalli.Enabled = False
        cmdLueTiedot.Enabled = False
    End If

    MuotoileGrid

    cmdLisaa.Enabled = False
    cmdUusi.Enabled = True
    cmdPaivita.Enabled = False

End Sub

Private Sub mnuSulje_Click()

    Unload Me

End Sub

Public myYhteys As ADODB.Connection

Function FileExists(nimi As String) As Boolean

   If Dir(nimi) = "" Then
       FileExists = False
   Else
       FileExists = True
   End If

End Function

Sub AvaaYhteys()

    Set myYhteys = New ADODB.Connection
    myYhteys.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Malli.mdb;"

    'Avataan tietokantayhteys
    myYhteys.Open

End Sub

Sub SuljeYhteys()

    'Suljetaan tietokantayhteys
    myYhteys.Close

End Sub