påmindelses program

Har du fået løst din problem? Ellers skriv lige lidt flere info, hvilken db arbejder du med? Hvordan? Skal du ikke blot redigere den med SQL sætninger? XML er også oplagt fra .NET

jeg arbejder med MS Access. og der skal jeg kunne skrive tid og en påmindelse ind og derefter skal jeg kunne gemme det i db'en og henter det når jeg åbner programmet igen.

Hvad skal du havbe hjælp til? At skrive/læse til/fra databasen fra VB?

Prøv med søgefunktionen, der er 1.000.000.000.000.000.000 spørgsmål om det emne.


Eksempel:

Vælg Project -> References
Find og tilføj Microsoft DAO 3.6 object library - så virker det. (Nummeret kan godt være lidt lavere f.eks. 3.51, det gør ikke noget.)

kode til at læse:

Dim rec As Recordset
Dim DB as Database 
Dim i as integer

Set DB = Workspaces(0).OpenDatabase("C:\database.mdb")
Set rec = DB.OpenRecordset _
    ("SELECT Række1, Række2, Række3 FROM Tabel ORDER BY Række1", dbOpenSnapshot)
'Række1,. og Tabel er navne angivet i din database

i=0
Do While Not rec.EOF
  i=i+1
  Msgbox "Post " & i & "i række 1 er : & rec!Række1
  rec.MoveNext
Loop
     
rec.Close
set DB = nothing

Hey lasse du for lige koden her...

----------------------------------
Option Explicit
Dim db As Database
Dim rs As Recordset
Dim ws As Workspace
Dim max As Long
Dim i As Long
Dim errormsg As VbMsgBoxStyle
Dim dbadd As Boolean
Dim dbedit As Boolean
Private Sub cmdSlet_Click()
errormsg = MsgBox("Er du sikker på at du vil slette denne aftale", vbCritical + vbYesNo, "Slet Aftale")
If errormsg = vbYes Then
rs.Delete
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
list
List2
Else
Exit Sub
End If
If rs.RecordCount = 0 Then
lisAftaler.Clear
lblEmne.Caption = "Emne"
lblDato.Caption = "Dato"
lblTid.Caption = "Tid"
txtNote.Text = "Note"
End If
End Sub

Private Sub Command1_Click()
frmNyA.Show
End Sub

Private Sub Form_Load()
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(App.Path & "\Aftaler.mdb")
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
list
List2
End Sub

Private Sub lblMainNow_Change()

If i = Now Then
MsgBox "jaaa"
End If
End Sub

Private Sub lisAftaler_Click()
If lisAftaler.Text > vbNullString Then
cmdSlet.Enabled = True
End If
Set rs = db.OpenRecordset("Select * from Aftaler where Emne = '" & Trim(lisAftaler.list(lisAftaler.ListIndex)) & "'")
rs.MoveFirst
lblEmne.Caption = rs("Emne")
lblDato.Caption = rs("Dato")
lblTid.Caption = rs("Tid")
txtNote.Text = rs("Note")
End Sub

Private Sub Timer1_Timer()
lblMainNow.Caption = Now
End Sub
Private Function list()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
lisAftaler.Clear
For i = 1 To max
    lisAftaler.AddItem rs("Emne")
    rs.MoveNext
Next i
End If
End Function
Private Function List2()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
List1.Clear
For i = 1 To max
    List1.AddItem rs("Dato") & " " & rs("Tid")
    rs.MoveNext
Next i
End If
End Function
Private Sub Command2_Click()
dbadd = True
If dbadd = True Then
    Call add
ElseIf dbedit = True Then
    'Call Edit
End If
txtEmne.Text = ""
lblDato.Caption = ""
lblTid.Caption = ""
txtNote.Text = ""
frmNyA.Hide
End Sub

Private Sub Form_Load()
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(App.Path & "\Aftaler.mdb")
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
End Sub

Private Sub lblDato_Click()
frmNyDato.Show
End Sub

Private Sub lblTid_Click()
frmNyTid.Show
End Sub
Private Function add()
If txtEmne.Text = vbNullString Or _
lblDato.Caption = vbNullString Or _
lblTid.Caption = vbNullString Or _
txtNote.Text = vbNullString Then
    errormsg = MsgBox("Alle felter skal udfyldes", vbCritical, "Fejl")
    Exit Function
End If

rs.AddNew
rs("Emne") = txtEmne.Text
rs("Dato") = lblDato.Caption
rs("Tid") = lblTid.Caption
rs("Note") = txtNote.Text
rs.Update

list
List2
End Function
Private Function list()
'If rs.RecordCount = 0 Then
'    errormsg = MsgBox("No Records Found", , "Error")
'    If Len(txtSearch.Text) > 0 Then
'        txtSearch.Text = Mid(txtSearch.Text, 1, Len(txtSearch.Text) - 1)
'    Else
'        Exit Function
'    End If
'End If
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
Form1.lisAftaler.Clear
For i = 1 To max
    Form1.lisAftaler.AddItem rs("Emne")
    rs.MoveNext
Next i
End Function
Private Function List2()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
Form1.List1.Clear
For i = 1 To max
    Form1.List1.AddItem rs("Dato") & " " & rs("Tid")
    rs.MoveNext
Next i
End If
End Function

Hey lasse du for lige koden her...

----------------------------------
Option Explicit
Dim db As Database
Dim rs As Recordset
Dim ws As Workspace
Dim max As Long
Dim i As Long
Dim errormsg As VbMsgBoxStyle
Dim dbadd As Boolean
Dim dbedit As Boolean
Private Sub cmdSlet_Click()
errormsg = MsgBox("Er du sikker på at du vil slette denne aftale", vbCritical + vbYesNo, "Slet Aftale")
If errormsg = vbYes Then
rs.Delete
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
list
List2
Else
Exit Sub
End If
If rs.RecordCount = 0 Then
lisAftaler.Clear
lblEmne.Caption = "Emne"
lblDato.Caption = "Dato"
lblTid.Caption = "Tid"
txtNote.Text = "Note"
End If
End Sub

Private Sub Command1_Click()
frmNyA.Show
End Sub

Private Sub Form_Load()
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(App.Path & "\Aftaler.mdb")
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
list
List2
End Sub

Private Sub lblMainNow_Change()

If i = Now Then
MsgBox "jaaa"
End If
End Sub

Private Sub lisAftaler_Click()
If lisAftaler.Text > vbNullString Then
cmdSlet.Enabled = True
End If
Set rs = db.OpenRecordset("Select * from Aftaler where Emne = '" & Trim(lisAftaler.list(lisAftaler.ListIndex)) & "'")
rs.MoveFirst
lblEmne.Caption = rs("Emne")
lblDato.Caption = rs("Dato")
lblTid.Caption = rs("Tid")
txtNote.Text = rs("Note")
End Sub

Private Sub Timer1_Timer()
lblMainNow.Caption = Now
End Sub
Private Function list()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
lisAftaler.Clear
For i = 1 To max
    lisAftaler.AddItem rs("Emne")
    rs.MoveNext
Next i
End If
End Function
Private Function List2()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
List1.Clear
For i = 1 To max
    List1.AddItem rs("Dato") & " " & rs("Tid")
    rs.MoveNext
Next i
End If
End Function
Private Sub Command2_Click()
dbadd = True
If dbadd = True Then
    Call add
ElseIf dbedit = True Then
    'Call Edit
End If
txtEmne.Text = ""
lblDato.Caption = ""
lblTid.Caption = ""
txtNote.Text = ""
frmNyA.Hide
End Sub

Private Sub Form_Load()
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(App.Path & "\Aftaler.mdb")
Set rs = db.OpenRecordset("Aftaler", dbOpenTable)
End Sub

Private Sub lblDato_Click()
frmNyDato.Show
End Sub

Private Sub lblTid_Click()
frmNyTid.Show
End Sub
Private Function add()
If txtEmne.Text = vbNullString Or _
lblDato.Caption = vbNullString Or _
lblTid.Caption = vbNullString Or _
txtNote.Text = vbNullString Then
    errormsg = MsgBox("Alle felter skal udfyldes", vbCritical, "Fejl")
    Exit Function
End If

rs.AddNew
rs("Emne") = txtEmne.Text
rs("Dato") = lblDato.Caption
rs("Tid") = lblTid.Caption
rs("Note") = txtNote.Text
rs.Update

list
List2
End Function
Private Function list()
'If rs.RecordCount = 0 Then
'    errormsg = MsgBox("No Records Found", , "Error")
'    If Len(txtSearch.Text) > 0 Then
'        txtSearch.Text = Mid(txtSearch.Text, 1, Len(txtSearch.Text) - 1)
'    Else
'        Exit Function
'    End If
'End If
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
Form1.lisAftaler.Clear
For i = 1 To max
    Form1.lisAftaler.AddItem rs("Emne")
    rs.MoveNext
Next i
End Function
Private Function List2()
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
max = rs.RecordCount
rs.MoveFirst
Form1.List1.Clear
For i = 1 To max
    Form1.List1.AddItem rs("Dato") & " " & rs("Tid")
    rs.MoveNext
Next i
End If
End Function