Gå til innhold

Anbefalte innlegg

Jeg er nybegynner med VB og leker meg litt.

 

Det jeg har begynt å lage er en enkel kontaktdatabase.

 

Det finnes sikkert mange smartere og mer fikse måter å gjøre det på, men det blir litt dumt å bare skrive av koder som jeg ikke forstår.

 

Her kommer koden ;)


Private Sub cmdApne_Click()

cmdApne.Visible = False
cmdLagre.Visible = False
cmdExit.Visible = False
CmdLeggtil.Visible = False
cmdRedigere.Visible = False
lblEtternavn.Visible = False
lblFornavn.Visible = False
lblTelefon.Visible = False
lblAdresse.Visible = False
txtEtternavn.Visible = False
txtFornavn.Visible = False
txtAdresse.Visible = False
txtTlf.Visible = False
lstEtternavn.Visible = False
lstFornavn.Visible = False
lstAdresse.Visible = False
lstTlf.Visible = False
Line1.Visible = False
Line2.Visible = False
Dir.Visible = True
fil.Visible = True
cmdapnefil.Visible = True
cmdavbryt.Visible = True
txtfilnavn.Visible = True


   
       

End Sub

Private Sub cmdapnefil_Click()
       pathEtternavn = Dir.path & txtfilnavn.Text & ".db" & "\" & "etternavn.txt"
       pathFornavn = Dir.path & txtfilnavn.Text & ".db" & "\" & "fornavn.txt"
       pathTlf = Dir.path & txtfilnavn.Text & ".db" & "\" & "telefon.txt"
       pathAdresse = Dir.path & txtfilnavn.Text & ".db" & "\" & "adresse.txt"
       
       Dim etternavn As String
       Open pathEtternavn For Input As #1
       Do
           Line Input #1, tekst
           lstEtternavn.AddItem (tekst)
       Loop Until EOF(1)
       Close #1

       Dim fornavn As String
       Open pathFornavn For Input As #1
       Do
           Line Input #1, tekst
           lstFornavn.AddItem (tekst)
       Loop Until EOF(1)
       Close #1

       Dim tlf As String
       Open pathTlf For Input As #1
       Do
           Line Input #1, tekst
           lstTlf.AddItem (tekst)
       Loop Until EOF(1)
       Close #1

       Dim adresse As String
       Open pathAdresse For Input As #1
       Do
           Line Input #1, tekst
           lstAdresse.AddItem (tekst)
       Loop Until EOF(1)
       Close #1
       
       cmdApne.Visible = True
cmdLagre.Visible = True
cmdExit.Visible = True
CmdLeggtil.Visible = True
cmdRedigere.Visible = True
lblEtternavn.Visible = True
lblFornavn.Visible = True
lblTelefon.Visible = True
lblAdresse.Visible = True
txtEtternavn.Visible = True
txtFornavn.Visible = True
txtAdresse.Visible = True
txtTlf.Visible = True
lstEtternavn.Visible = True
lstFornavn.Visible = True
lstAdresse.Visible = True
lstTlf.Visible = True
Line1.Visible = True
Line2.Visible = True
Dir.Visible = False
fil.Visible = False
cmdapnefil.Visible = False
cmdavbryt.Visible = False
txtfilnavn.Visible = False
End Sub

Private Sub cmdExit_Click()
   If MsgBox("Vil du avslutte?", vbCritical + vbYesNo, "Avslutte?") = vbYes Then
       End
   End If
End Sub

Private Sub CmdLeggtil_Click()

   Dim lFornavn, lEtternavn, ltlf, ladresse


   If txtEtternavn.Text = "" And txtFornavn.Text = "" And txtTlf.Text = "" And txtAdresse.Text = "" Then
       MsgBox "Du har ikke skrevet noe", vbInformation, "Obs"
       
   
   Else
       lEtternavn = txtEtternavn.Text
       lFornavn = txtFornavn.Text
       ltlf = txtTlf.Text
       ladresse = txtAdresse.Text
   
       If lEtternavn = "" Then
          lEtternavn = "<ingen info>"
       End If
       
       If lFornavn = "" Then
           lFornavn = "<ingen info>"
       End If
       
       If ltlf = "" Then
          ltlf = "<ingen info>"
       End If
       
       If ladresse = "" Then
           ladresse = "<ingen info>"
       End If
       
       lstFornavn.AddItem lFornavn
       lstEtternavn.AddItem lEtternavn
       lstAdresse.AddItem ladresse
       lstTlf.AddItem ltlf
       
       txtFornavn.Text = ""
       txtEtternavn.Text = ""
       txtAdresse.Text = ""
       txtTlf.Text = ""
       lFornavn = ""
       lEtternavn = ""
       ladresse = ""
       ltlf = ""
   
   End If
   

   

End Sub

Private Sub Dir_Change()
fil.path = Dir.path
txtfilnavn.Text = fil.filename
path = Dir.path & fil.filename
End Sub

Private Sub fil_Click()
Dir.path = fil.path
txtfilnavn.Text = fil.filename
path = Dir.path & fil.filename
End Sub

Private Sub Form_Load()
   cmdLagre.Caption = "Lagre"
   cmdApne.Caption = "Åpne"
   cmdRedigere.Caption = "Rediger"
   CmdLeggtil.Caption = "Legg til"
   cmdExit.Caption = "Avslutt"
   txtEtternavn.Text = ""
   txtFornavn.Text = ""
   txtTlf.Text = ""
   txtAdresse.Text = ""
   lblEtternavn.Caption = "Etternavn"
   lblFornavn.Caption = "Fornavn"
   lblTelefon.Caption = "Telefon"
   lblAdresse.Caption = "Adresse"
   Dir.Visible = False
   fil.Visible = False
   cmdapnefil.Visible = False
   cmdavbryt.Visible = False
   txtfilnavn.Visible = False
   fil.path = "c:\"
   Dir.path = "c:\"
   txtfilnavn.Text = ""
   cmdavbryt.Caption = "Avbryt"
   cmdapnefil.Caption = "Åpne"
End Sub

 

Som dere ser så har jeg greid å hente inn data fra fire tekstdokumenter, men jeg har enda ikke greid å lagre noe. Hvordan gjør jeg det? Takker for alle svar.

 

Legger med filene!

Kontaktdatabase.zip

Endret av Blackslash
Lenke til kommentar
Videoannonse
Annonse

For å lagre noe skriver du enten:

open filename for output as #1
print #1, "tekst"
close #1

Den vil slette alt som lå i filename fra før å lage en helt ny fil

Eller du kan gjøre det slik:

open filename for append as #1
print #1, "tekst"
close #1

Denne legger teksten din til på slutten av filen.

 

Ett lite tips til, i stedenfor å skrive navnet på alle tingene som ikke skal være synlig, legg dem i en frame, da skriver du bare frame1.visible=false

så blir alt som er oppi den usynlig.

 

Edit, skriveleif

Endret av trrunde
Lenke til kommentar
Hvordan kan jeg lage en ny mappe?

Enten via MkDir, såsom dette:

 

' Lag èn ny mappe - funksjonen kan ikke lage flere samtidig

MkDir "C:\Ny mappe\"

 

Eller via SHCreateDirectoryEx-API-kallet, som muliggjør for skapelse av flere mapper samtidig:

 

' Denne koden må legges øverst i formen/klassemodulen, eller i en modul uten 'Private'-kodeordet

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long

 

Private Sub Form_Load()

 

    ' Lag flere nye mapper

    SHCreateDirectoryEx Me.hwnd, "C:\Ny mappe\Undermappe\Hallo\Et eller annet\Visual Basic\", ByVal 0&

   

End Sub

Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...