Member Avatar for raniel1314 
Option Explicit
Dim rs As ADODB.Recordset
Dim savePurpose As String
Private Sub getData()
    Call EnableEntryControls(False)
    lvRec.ListItems.Clear
    Set rs = GetRecordset("Select * from tblDocSched")
    If Not rs.EOF Then 'records exists
        Call SearchMode(True)
        While Not rs.EOF
            lvRec.ListItems.Add , , rs.Fields("PhysicianNo").Value
            lvRec.ListItems(lvRec.ListItems.Count).ListSubItems.Add , , rs.Fields("PhysicianName").Value
            lvRec.ListItems(lvRec.ListItems.Count).ListSubItems.Add , , _
            IIf(IsNull(rs.Fields("Department").Value), "", rs.Fields("Department").Value)
            lvRec.ListItems(lvRec.ListItems.Count).ListSubItems.Add , , _
            IIf(IsNull(rs.Fields("DateAvailable").Value), "", rs.Fields("DateAvailable").Value)
            lvRec.ListItems(lvRec.ListItems.Count).ListSubItems.Add , , _
            IIf(IsNull(rs.Fields("Time").Value), "", rs.Fields("Time").Value)
            rs.MoveNext
        Wend
        lvRec.ListItems.Item(1).Selected = True
        txtNo.Text = lvRec.SelectedItem.Text
        txtName.Text = lvRec.SelectedItem.SubItems(1)
        txtDep.Text = lvRec.SelectedItem.SubItems(2)
        DTPicker1.Value = lvRec.SelectedItem.SubItems(3)
         DTPicker2.Value = lvRec.SelectedItem.SubItems(4)
       Call SearchMode(True)
        Call ButtonModes(True, True, True, False, False, True)
    Else ' No records
        txtNo.Text = "": txtName.Text = "": txtDep.Text = ""
        DTPicker1.Value = "": DTPicker2.Value = ""
        Call SearchMode(False)
        Call ButtonModes(True, False, False, False, False, True)
    End If
    Set rs = Nothing
    lvRec.Enabled = True
End Sub
Private Sub ButtonModes(ByVal bAdd As Boolean, _
                        ByVal bEdit As Boolean, _
                        ByVal bDelete As Boolean, _
                        ByVal bSave As Boolean, _
                        ByVal bCancel As Boolean, _
                        ByVal bExit As Boolean)
    With Toolbar1
        .Buttons(1).Enabled = bAdd
        .Buttons(2).Enabled = bEdit
        .Buttons(3).Enabled = bDelete
        .Buttons(4).Enabled = bSave
        .Buttons(5).Enabled = bCancel
        .Buttons(6).Enabled = bExit
    End With
End Sub
Private Sub SearchMode(ByVal bEnable As Boolean)
    optNo.Value = True
    txtSearch.Text = ""
    txtSearch.Enabled = bEnable
    btnSearch.Enabled = bEnable
    optNo.Enabled = bEnable
    optName.Enabled = bEnable
End Sub
Private Sub ClearEntryControls(ByVal b As Boolean)
    If b = True Then
        txtNo.Text = ""
        txtName.Text = ""
        txtDep.Text = ""
        DTPicker1.Value = ""
        DTPicker2.Value = ""
    End If
    txtNo.SetFocus
End Sub
Private Sub EnableEntryControls(ByVal b As Boolean)
    txtNo.Enabled = b
    txtName.Enabled = b
    txtDep.Enabled = b
    DTPicker1.Enabled = False
    DTPicker2.Enabled = False
End Sub
Private Sub btnSearch_Click()
Dim i As Integer
Dim bFound As Boolean
If Trim(txtSearch.Text) = "" Then
    MsgBox "Please Input Value To Be Searched!", vbExclamation, Me.Caption
    Exit Sub
End If
If Not lvRec.ListItems.Count = 0 Then
    If optNo.Value = True Then
        For i = 1 To lvRec.ListItems.Count
            If UCase(Trim(txtSearch.Text)) = UCase(Trim(lvRec.ListItems(i).Text)) Then
                bFound = True
                Exit For
            End If
        Next
    ElseIf optName.Value = True Then
        For i = 1 To lvRec.ListItems.Count
            If UCase(Trim(txtSearch.Text)) = UCase(Trim(lvRec.ListItems(i).SubItems(1))) Then
                bFound = True
                Exit For
            End If
        Next
    End If
    If bFound = True Then
        lvRec.ListItems(i).Selected = True
        txtNo.Text = lvRec.SelectedItem.Text
        txtName.Text = lvRec.SelectedItem.SubItems(1)
        txtDep.Text = lvRec.SelectedItem.SubItems(2)
        DTPicker1.Value = lvRec.SelectedItem.SubItems(3)
        DTPicker2.Value = lvRec.SelectedItem.SubItems(4)
        lvRec.SetFocus
        Exit Sub
    End If
    MsgBox "Not Found!", vbInformation, Me.Caption
End If
End Sub
Private Sub Form_Load()
Call getData
End Sub
Private Sub lvRec_Click()
If Not lvRec.ListItems.Count = 0 Then
 txtNo.Text = lvRec.SelectedItem.Text
 txtName.Text = lvRec.SelectedItem.SubItems(1)
        txtDep.Text = lvRec.SelectedItem.SubItems(2)
        DTPicker1.Value = lvRec.SelectedItem.SubItems(3)
        DTPicker2.Value = lvRec.SelectedItem.SubItems(4)
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 1 ' New
        lvRec.Enabled = False
        Call EnableEntryControls(True)
        Call ClearEntryControls(True)
        Call SearchMode(False)
        Call ButtonModes(False, False, False, True, True, False)
        DTPicker1.Enabled = True
        DTPicker2.Enabled = True
        savePurpose = "INSERT"
    Case 2 ' Edit
        lvRec.Enabled = False
        Call EnableEntryControls(True)
        Call SearchMode(False)
        Call ButtonModes(False, False, False, True, True, False)
        DTPicker1.Enabled = True
        DTPicker2.Enabled = True
        txtNo.Enabled = False
        savePurpose = "UPDATE"
    Case 3 ' Delete
        Call SearchMode(False)
        If MsgBox("Delete " & lvRec.SelectedItem.Text & "?", vbQuestion + vbYesNo) = vbYes Then
                        'delete record
            Set rs = GetRecordset("DELETE FROM tblDocSched WHERE PhysicianNo='" & txtNo.Text & "'")
            Set rs = Nothing
        End If
        Call getData
    Case 4 'Save
        'validation
        If Trim(txtName.Text) = "" Then
            MsgBox "Physician Name is Required!", vbExclamation, Me.Caption
            txtName.Text = ""
            txtName.SetFocus
            Exit Sub
        End If
        If Trim(txtDep.Text) = "" Then
            MsgBox "Department is Required!", vbExclamation, Me.Caption
            txtDep.Text = ""
            txtDep.SetFocus
            Exit Sub
        End If
        If DTPicker1.CheckBox = False Then
            MsgBox "date is Required!", vbExclamation, Me.Caption
           DTPicker1.Value = ""
           DTPicker1.SetFocus
        Exit Sub
       End If
       If DTPicker2.CheckBox = False Then
            MsgBox "Time is Required!", vbExclamation, Me.Caption
            DTPicker2.Value = ""
            DTPicker2.SetFocus
        Exit Sub
        End If
        Select Case UCase(savePurpose)
            Case "INSERT"
                'Search if Exists
                Set rs = GetRecordset("SELECT * FROM tblDocSched WHERE PhysicianNo='" & Trim(txtNo.Text) & "'")
                If Not rs.EOF = True Then
                    MsgBox "Physician Number Already Exists In The Database", vbCritical, Me.Caption
                    txtNo.SelStart = 0: txtNo.SelLength = Len(txtNo.Text): txtNo.SetFocus
                    Exit Sub
                End If
                Set rs = GetRecordset("INSERT INTO tblDocSched(PhysicianNo, PhysicianName, Department, DateAvailable, Time)Values('" & txtNo.Text & "', '" & txtName.Text & "', '" & txtDep.Text & "','" & DTPicker1.Value & "', '" & DTPicker2.Value & "')")
            Case "UPDATE"
                Set rs = GetRecordset("UPDATE tblDocSched set PhysicianName='" & Replace(Trim(txtName.Text), "'", "''") & "',Department='" & Replace(Trim(txtDep.Text), "'", "''") & "',DateAvailable='" & Replace(Trim(DTPicker1.Value), "'", "''") & "', Time='" & Replace(Trim(DTPicker2.Value), "'", "''") & "' where PhysicianNo = '" & txtNo.Text & "'")
        End Select
        Set rs = Nothing
        Call getData
        MsgBox "Successfully Saved!", vbInformation, Me.Caption
    Case 5 'Cancel
        Call getData
    Case 6 'Unload form
'        MsgBox "Form closed !", vbInformation
'        Unload Me
'        frmMain.Toolbar1.Enabled = True
'        frmMain.Show
Dim ask As String
ask = MsgBox("Do you want to close this form?", vbQuestion + vbYesNo, "Are you sure?")
If ask = vbYes Then
    MsgBox "Doctor Schedule form Closed!", vbInformation, "Form Closed!"
    Unload Me
    frmMain.Toolbar2.Enabled = True
    frmMain.Show
Else
        MsgBox "Cancelled !", vbExclamation, "Exit Cancelled !"
        Exit Sub
    End If
End Select
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then btnSearch.SetFocus
End Sub

i have a code here i know it is accurate but the code of my insert into statement is not running i don't know why. please help me.

  • 3 Contributors
  • 3 Replies
  • 247 Views
  • 23 Hours Discussion Span
  • Latest Post Latest Post by AndreRet
Member Avatar for AndreRet

@Raniel1314,

You need to open your own thread please. We will not reply on this thread, it belongs to another member and it is quite old.

Post a new one, I'll answer from there.

Member Avatar for Ezzaral

Splitting to new thread. Raniel, please do not hijack old threads when posting a question.

Member Avatar for AndreRet

I personally do not like, or use, "Insert" very much because of all the special characters required. I always use -

Set rs = New ADODB.Recordset

rs.Open "SELECT * FROM tblDocSched", con, adOpenstatic, adLockOptimistic

rs.AddNew

rs!PhysicianNo = txtNo.Text
rs!DateAvailable = DTPicker1.Value
'etc...
rs.Update

rs.Close
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.