| {\rtf1\ansi\ansicpg1252\deff0\deflang1044{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}} {\colortbl ;\red0\green0\blue255;} \viewkind4\uc1\pard\f0\fs17 This is a simple sample in two parts, first project1.vbp is a sample of ADO with text and other types of files. The second part is for reading, writing, adding and editing to a database. This is for people who are looking for simple samples of ADO The ADO through files has to be observed when the code is running becuase it is only meant for tempdata. This has been written for windows 95, 98, ME, NT and 2000 but it hasn't been tested in only 2000. Be sure to follow the instructions from the readme, there are almost no instructions but the one that I give, the code depends on. Also, the database is in Microsoft Access 97. \par \par Form1: \par \par \par \par Private Sub Command1_Click() \par 'This is for writing data to a temp file each time overwriting the previous data \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output As #1'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output As #1'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command10_Click() \par 'This is for writing data to a temp file each time overwriting the previous data in Lock Read write mode \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output Lock Read Write As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output Lock Read Write As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par Private Sub Command12_Click() \par 'This is for writing data to a temp file each time overwriting the previous data in a random \par Dim FileNumber \par FileNumber = 1 \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output As #FreeFile 'This opens the file as an output file \par Print #FreeFile, "this is a line" 'This writes a line in the text file \par Print #FreeFile, "This is another Line"'This writes a line in the text file \par Close #FreeFile'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output As #FreeFile 'This opens the file as an output file \par Print #FreeFile, "this is a line" 'This writes a line in the text file \par Print #FreeFile, "This is another Line"'This writes a line in the text file \par Close #FreeFile'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command13_Click() \par 'This is for writing data to a temp file each time overwriting the previous data beginning and specify record length \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output As #1 Len = 10000 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output As #1 Len = 10000 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command2_Click() \par 'This is for writing data to a temp file each time Appending to the previous data \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\Windows\\temp\\~00001.tmp" For Append As #1'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Append As #1'This opens the file as an output file \par Print #1, "This is a line that appended"'This writes a line in the text file \par Print #1, "This is another Line that appended"'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command3_Click() \par 'This Reads Data from a file \par Dim retval \par Open "C:\\ado\\test.ini" For Input As #1'This opens the file as an output file \par Do Until EOF(1) \par Line Input #1, Data \par retval = MsgBox(Data, vbOKOnly, "Data") \par Loop \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End Sub \par \par \par \par Private Sub Command4_Click() \par 'This is for writing data to a temp file each time Binary \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\Windows\\temp\\~00001.tmp" For Binary Access Write As #1 'This opens the file as an output file \par Put #1, 30, "This is a line that appended"'This writes a line in the text file \par Put #1, 100, " " \par Put #1, 500, "This is another Line that appended" \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Binary Access Write As #1 'This opens the file as an output file \par Put #1, 30, "This is a line that appended"'This writes a line in the text file \par Put #1, 100, " " \par Put #1, 500, "This is another Line that appended"'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command5_Click() \par 'This is for writing in a random order \par Open "c:\\ado\\test.db" For Random As #1 \par Put #1, 1, "This is a line that appended"'This writes a line in the text file \par Put #1, 2, "This is another Line that appended"'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End Sub \par \par \par Private Sub Command7_Click() \par 'This is for writing data to a temp file each time overwriting the previous data in shared mode \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output Shared As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output Shared As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par Private Sub Command8_Click() \par 'This is for writing data to a temp file each time overwriting the previous data in Lock write mode \par If Err.Number = 76 Then'Test for 98 \par Open "C:\\windows\\temp\\~00001.tmp" For Output Lock Write As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par Else \par Open "C:\\winnt\\temp\\~00001.tmp" For Output Lock Write As #1 'This opens the file as an output file \par Print #1, "this is a line" 'This writes a line in the text file \par Print #1, "This is another Line" 'This writes a line in the text file \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End If \par End Sub \par \par \par \par Private Sub Command9_Click() \par 'This is for writing data to a temp file each time overwriting the previous data in Lock Read mode \par Dim retval \par Open "C:\\ado\\test.ini" For Input Lock Read As #1'This opens the file as an output file \par Do Until EOF(1) \par Line Input #1, Data \par retval = MsgBox(Data, vbOKOnly, "Data") \par Loop \par Close #1'This closes the file, otherwise it would remain open until the user restarts their machine \par End Sub \par \par \par Private Sub Form_Load() \par 'on error resume next'This is for continuing on errors \par FileCopy "C:\\ADO\\test.txt", "C:\\windows\\temp\\~00001.tmp" 'This is for Windows 98 \par If Err.Number = 76 Then'This is the error code for path not found(This is one way to error handle) \par FileCopy "C:\\ADO\\test.txt", "C:\\winnt\\temp\\~00001.tmp" \par 'This is encase you want to use a temp file to write temporary data in windows NT or 2000 \par End If \par End Sub \par \par \par \par Private Sub Form_Unload(Cancel As Integer) \par 'on error resume next \par Kill "C:\\windows\\temp\\~00001.tmp" 'This deletes the temp File for 98 \par If Err.Number = 53 Then \par Kill "C:\\winnt\\temp\\~00001.tmp" 'This deletes the temp File for NT and 2000 \par End If \par End Sub \par \par 'error 76 = Path not found \par 'error 53 = file not found \par \par \par This is part 2, writing to a database. \par \par \par Form 1: \par \par ' Writing to and from a Database \par ' Albert A. Hocking III \par ' Getting the code to work \par 'This is from the data form wizard from the addin menu \par 'This also, is the sample code that you can use for a template \par 'there are a few things that you have to do to get this working. \par 'You have to include the data access components so that the database can be recognized. This is done by \par 'On the menu bar Project->References->Microsoft Data Access Objects 2.1 Library(or 2.5 if you want) \par \par ' Using the Data-form Wizard \par 'If you want to use the data form wizard then, \par 'Add-Ins->Addin Manager->VB 6 Dataform Wizard. \par 'This click on Loaded and unloaded and then click load on startup or you will have to do it each time. \par ' \par 'After that your done, it should work after you update your ADO folder \par \par \par Private Sub Command1_Click() \par Me.Hide \par frmProducts.Show \par End Sub \par \par \par \par Private Sub Command2_Click() \par End \par End Sub \par \par \par \par Private Sub Command3_Click() \par Me.Hide \par frmProducts1.Show \par End Sub \par \par \par \par Private Sub Command5_Click() \par Form2.Show \par Me.Hide \par End Sub \par \par \par Private Sub Form_Load() \par Form1.Top = (Screen.Height - Form1.Height) / 2 \par Form1.Left = (Screen.Width - Form1.Width) / 2 \par End Sub \par \par \par \par Form2: \par \par 'This form was created by me. This more willingly gives the code \par 'for Adding Editing and Deleting Records in a table in a database \par 'Be sure if you want to edit the code \par 'The specify "ADO code in the wizard with the proper radio button \par 'SEE THE COMMENTS FOR THE EXPINATION OF WHAT I'M DOING \par \par Private Sub Command1_Click() 'This routine if for moving to the previous record \par 'on error resume next'Error Handeling \par \par Dim db As Connection'Sets the variable for the database \par Dim rs As Recordset'Sets the variable for the record set \par Dim retval As Variant'A BS variable for for msgbox's \par \par Set db = New Connection 'Specifies a new connection to the database \par Set rs = New Recordset 'does the same aas the recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" 'Loads the Microsoft Access 97 Driver \par db.Open'Loads opens the database that is in the line above \par rs.Open "SELECT ProductID, ProductName FROM products", db, adOpenDynamic, adLockPessimistic 'Opens the table with SQL, specifies the Database through the variable, opens it with dynamic so if other users change it, and has a pecimistic lock(that means that when you bite on a record, its locked until you move to another one, otherwise, its locked to other users for update) \par \par rs.MoveFirst'Moves to the first record so that the correct on can be found \par \par \par \par If Me.Text2 = rs!ProductID Then \par 'Once it has moved to the first record, if the text box that has the key is equals the first record in the table then it will \par ' not go back \par retval = MsgBox("You have reached the beginning of the Table", vbCritical, "EOF") \par 'This is the message for the condition when the user can't go back \par Exit Sub'Ends the code \par End If'Ends the condition \par \par \par \par If Err.Number = 3021 Then 'This test for the "EOF or BOF is true or the previous record has been deleted" \par retval = MsgBox("Your are at the beginning of the recordset", vbCritical, "An error has ocurred") \par 'This is the message for the Error \par End If'This ends the condition \par \par Me.Text2.Text = Me.Text2.Text - 1 'This subtracts one value from the Key box for comparision with the table \par \par \par \par Do While Not rs.EOF'Loop that rolls through the table \par rs.MoveNext'Moves to the next record \par \par \par If rs!ProductID = Me.Text2.Text Then'Tests for the previous record \par Me.Text1 = rs!ProductName 'Places the value in the text box \par Me.Text2 = rs!ProductID 'Places the value in the text box \par Exit Sub'Exits the Subroutine \par End If'Ends the Condition \par Loop'For the repition structure \par \par Set db = Nothing'Kills the connection to the Database(DON'T LEAVE THIS OUT, YOU WILL WAIST MEMORY) \par Set rs = Nothing'This does the same with the recordset \par \par End Sub \par \par \par Private Sub Command2_Click() \par 'This moves to the next record - AT THIS POINT i WILL NOT REEXPLAIN PREVIOUS CODE \par 'on error resume next \par \par Dim db As Connection \par Dim rs As Recordset \par Dim retval As Variant \par \par Set db = New Connection \par Set rs = New Recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" \par db.Open \par rs.Open "SELECT ProductID, ProductName FROM products", db, adOpenDynamic, adLockPessimistic \par \par rs.MoveLast'This moves the last record \par \par \par If Me.Text2 = rs!ProductID Then 'This tests to see if user is on the last record \par retval = MsgBox("You have reached the end of the Table", vbCritical, "EOF")'This displays a message box \par Exit Sub'This exits the subroutine \par End If'Ends the condition \par \par rs.MoveFirst \par \par Me.Text2.Text = Me.Text2.Text + 1 'Adds one to the key value so that it can be compired \par \par \par \par If Err.Number = 3021 Then \par retval = MsgBox("Your are at the beginning of the recordset", vbCritical, "An error has ocurred") \par Else \par \par \par Do Until rs.EOF \par rs.MoveNext \par \par \par If rs!ProductID = Me.Text2.Text Then \par Me.Text1 = rs!ProductName \par Me.Text2 = rs!ProductID \par Exit Sub \par End If \par Loop \par End If \par \par \par Set db = Nothing \par Set rs = Nothing \par End Sub \par \par \par Private Sub Command3_Click() 'This edits a recordset \par 'on error resume next \par \par Dim db As Connection \par Dim rs As Recordset \par Dim retval As Variant \par \par Set db = New Connection \par Set rs = New Recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" \par db.Open \par rs.Open "SELECT ProductID, ProductName FROM products", db, adOpenDynamic, adLockPessimistic \par \par rs.MoveFirst \par \par If Err.Number = 3021 Then \par retval = MsgBox("Your are at the beginning of the recordset", vbCritical, "An error has ocurred") \par Else \par \par Do Until rs.EOF \par rs.MoveNext \par \par If rs!ProductID = Me.Text2.Text Then \par rs!ProductName = Me.Text1 'This gives the same value to the table record(and its buffered) \par rs.Update'This Writes the value to the database \par rs!ProductID = Me.Text2 'same Code \par rs.Update'Same Code \par Exit Sub \par End If \par Loop \par End If \par \par \par Set db = Nothing \par Set rs = Nothing \par \par End Sub \par \par \par Private Sub Command4_Click() \par Me.Hide \par Form1.Show \par End Sub \par \par Private Sub Command5_Click() \par Me.Text1.Text = ""'Clears the Boxes of the values \par Me.Text2.Text = "" \par End Sub \par \par \par Private Sub Command7_Click() \par Dim db As Connection \par Dim rs As Recordset \par Dim retval As Variant \par \par Set db = New Connection \par Set rs = New Recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" \par db.Open \par rs.Open "SELECT * FROM Products", db, adOpenDynamic, adLockPessimistic \par \par rs.MoveFirst \par \par Do Until rs.EOF \par \par If rs!ProductID = Me.Text2.Text Then \par rs.Delete'Prepares the record to be deleted \par rs.Update'Updates the recordset \par rs.MoveNext'Moves to the next record \par Me.Text1 = rs!ProductName 'Populates the box with the next availble record \par Me.Text2 = rs!ProductID 'same code different field \par Exit Sub \par End If \par rs.MoveNext \par Loop \par \par Set db = Nothing \par Set rs = Nothing \par End Sub \par \par \par \par Private Sub Command8_Click() \par Dim db As Connection \par Dim rs As Recordset \par Dim retval As Variant \par \par Set db = New Connection \par Set rs = New Recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" \par db.Open \par rs.Open "SELECT ProductID, ProductName FROM products", db, adOpenDynamic, adLockPessimistic \par \par rs.MoveLast \par rs.AddNew'Tells the database to go to the end \par rs!ProductName = Me.Text1 'transfurs the data \par rs.Update'Writes the data \par \par Set db = Nothing \par Set rs = Nothing \par End Sub \par \par \par \par Private Sub Form_Load()'Displays the first record \par \par \par Form2.Top = (Screen.Height - Form2.Height) / 2 \par \par \par Form2.Left = (Screen.Width - Form2.Width) / 2 \par \par Dim db As Connection \par Dim rs As Recordset \par Set db = New Connection \par Set rs = New Recordset \par \par db.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;" & "Data Source=C:\\ADO\\Northwind.mdb;" \par db.Open \par rs.Open "SELECT ProductID, ProductName FROM products", db, adOpenDynamic, adLockPessimistic \par \par rs.MoveFirst \par Me.Text1 = rs!ProductName \par Me.Text2 = rs!ProductID \par \par Set db = Nothing \par Set rs = Nothing \par \par \par Form1.Show \par \par End Sub \par \par \par \par Private Sub Form_Unload(Cancel As Integer)'Property for the exit \par Me.Text1.Text = ""'Clears the textbox \par Me.Text2.Text = ""'Clears the textbox \par \par \par Form1.Show'Shows the main form \par \par End Sub \par \par frmProducts: \par \par 'This form is created with the form wizard \par 'Be sure if you want to edit the code \par 'The specify "ADO code in the wizard with the proper radio button \par \par Dim WithEvents adoPrimaryRS As Recordset \par Dim mbChangedByCode As Boolean \par Dim mvBookMark As Variant \par Dim mbEditFlag As Boolean \par Dim mbAddNewFlag As Boolean \par Dim mbDataChanged As Boolean \par \par \par \par Private Sub Form_Load() \par frmProducts.Top = (Screen.Height - frmProducts.Height) / 2 \par frmProducts.Left = (Screen.Width - frmProducts.Width) / 2 \par \par Dim db As Connection \par Set db = New Connection \par db.CursorLocation = adUseClient \par db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=C:\\ADO\\Northwind.mdb;" \par \par Set adoPrimaryRS = New Recordset \par adoPrimaryRS.Open "select Discontinued,ProductName,QuantityPerUnit,ReorderLevel,SupplierID,UnitPrice,UnitsInStock,UnitsOnOrder from Products", db, adOpenStatic, adLockOptimistic \par \par Set grdDataGrid.DataSource = adoPrimaryRS \par \par mbDataChanged = False \par End Sub \par \par \par \par Private Sub Form_Resize() \par 'on error resume next \par 'This will resize the grid when the form \par ' is resized \par grdDataGrid.Height = Me.ScaleHeight - 30 - picButtons.Height - picStatBox.Height \par lblStatus.Width = Me.Width - 1500 \par cmdNext.Left = lblStatus.Width + 700 \par cmdLast.Left = cmdNext.Left + 340 \par End Sub \par \par \par \par Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) \par If mbEditFlag Or mbAddNewFlag Then Exit Sub \par \par \par \par Select Case KeyCode \par Case vbKeyEscape \par cmdClose_Click \par Case vbKeyEnd \par cmdLast_Click \par Case vbKeyHome \par cmdFirst_Click \par Case vbKeyUp, vbKeyPageUp \par \par \par If Shift = vbCtrlMask Then \par cmdFirst_Click \par Else \par cmdPrevious_Click \par End If \par Case vbKeyDown, vbKeyPageDown \par \par \par If Shift = vbCtrlMask Then \par cmdLast_Click \par Else \par cmdNext_Click \par End If \par End Select \par End Sub \par \par \par \par Private Sub Form_Unload(Cancel As Integer) \par \par Screen.MousePointer = vbDefault \par \par \par Form1.Show \par End Sub \par \par \par \par Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) \par 'This will display the current record po \par ' sition for this recordset \par lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition) \par End Sub \par \par \par \par Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) \par 'This is where you put validation code \par 'This event gets called when the followi \par ' ng actions occur \par Dim bCancel As Boolean \par \par \par \par Select Case adReason \par Case adRsnAddNew \par Case adRsnClose \par Case adRsnDelete \par Case adRsnFirstChange \par Case adRsnMove \par Case adRsnRequery \par Case adRsnResynch \par Case adRsnUndoAddNew \par Case adRsnUndoDelete \par Case adRsnUndoUpdate \par Case adRsnUpdate \par End Select \par \par If bCancel Then adStatus = adStatusCancel \par End Sub \par \par \par \par Private Sub cmdAdd_Click() \par On Error GoTo AddErr \par adoPrimaryRS.MoveLast \par adoPrimaryRS.AddNew \par grdDataGrid.SetFocus \par \par Exit Sub \par AddErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdDelete_Click() \par On Error GoTo DeleteErr \par \par \par With adoPrimaryRS \par .Delete \par .MoveNext \par If .EOF Then .MoveLast \par End With \par Exit Sub \par DeleteErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdRefresh_Click() \par 'This is only needed for multi user apps \par ' \par On Error GoTo RefreshErr \par Set grdDataGrid.DataSource = Nothing \par adoPrimaryRS.Requery \par Set grdDataGrid.DataSource = adoPrimaryRS \par \par Exit Sub \par RefreshErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdEdit_Click() \par On Error GoTo EditErr \par \par lblStatus.Caption = "Edit record" \par mbEditFlag = True \par SetButtons False \par Exit Sub \par \par EditErr: \par MsgBox Err.Description \par End Sub \par \par \par Private Sub cmdCancel_Click() \par 'on error resume next \par \par SetButtons True \par mbEditFlag = False \par mbAddNewFlag = False \par adoPrimaryRS.CancelUpdate \par \par \par If mvBookMark > 0 Then \par adoPrimaryRS.Bookmark = mvBookMark \par Else \par adoPrimaryRS.MoveFirst \par End If \par mbDataChanged = False \par \par End Sub \par \par \par \par Private Sub cmdUpdate_Click() \par On Error GoTo UpdateErr \par \par adoPrimaryRS.UpdateBatch adAffectAll \par \par \par \par If mbAddNewFlag Then \par adoPrimaryRS.MoveLast 'move to the new record \par End If \par \par mbEditFlag = False \par mbAddNewFlag = False \par SetButtons True \par mbDataChanged = False \par \par Exit Sub \par UpdateErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdClose_Click() \par Unload Me \par End Sub \par \par \par \par Private Sub cmdFirst_Click() \par On Error GoTo GoFirstError \par \par adoPrimaryRS.MoveFirst \par mbDataChanged = False \par \par Exit Sub \par \par GoFirstError: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdLast_Click() \par On Error GoTo GoLastError \par \par adoPrimaryRS.MoveLast \par mbDataChanged = False \par \par Exit Sub \par \par GoLastError: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdNext_Click() \par On Error GoTo GoNextError \par \par If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext \par \par \par If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then \par Beep \par 'moved off the end so go back \par adoPrimaryRS.MoveLast \par End If \par 'show the current record \par mbDataChanged = False \par \par Exit Sub \par GoNextError: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdPrevious_Click() \par On Error GoTo GoPrevError \par \par If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious \par \par \par If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then \par Beep \par 'moved off the end so go back \par adoPrimaryRS.MoveFirst \par End If \par 'show the current record \par mbDataChanged = False \par \par Exit Sub \par \par GoPrevError: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub SetButtons(bVal As Boolean) \par cmdAdd.Visible = bVal \par cmdEdit.Visible = bVal \par cmdUpdate.Visible = Not bVal \par cmdCancel.Visible = Not bVal \par cmdDelete.Visible = bVal \par cmdClose.Visible = bVal \par cmdRefresh.Visible = bVal \par cmdNext.Enabled = bVal \par cmdFirst.Enabled = bVal \par cmdLast.Enabled = bVal \par cmdPrevious.Enabled = bVal \par End Sub \par \par frmProducts1: \par \par '*************************************** \par ' **************************************** \par ' **************************************** \par ' **************************************** \par ' ********************** \par 'This is the default form is created wit \par ' h the form wizard \par 'Be sure if you want to edit the code \par 'The specify "ADO code in the wizard wit \par ' h the proper radio button \par '*************************************** \par ' **************************************** \par ' **************************************** \par ' **************************************** \par ' ********************** \par Dim WithEvents adoPrimaryRS As Recordset \par Dim mbChangedByCode As Boolean \par Dim mvBookMark As Variant \par Dim mbEditFlag As Boolean \par Dim mbAddNewFlag As Boolean \par Dim mbDataChanged As Boolean \par \par \par \par Private Sub Form_Load() \par Dim db As Connection \par Set db = New Connection \par db.CursorLocation = adUseClient \par db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=C:\\ADO\\Northwind.mdb;" \par \par Set adoPrimaryRS = New Recordset \par adoPrimaryRS.Open "select ProductID,ProductName from Products", db, adOpenStatic, adLockOptimistic \par \par Dim oText As TextBox \par 'Bind the text boxes to the data provide \par ' r \par \par \par For Each oText In Me.txtFields \par Set oText.DataSource = adoPrimaryRS \par Next \par \par mbDataChanged = False \par End Sub \par \par \par \par Private Sub Form_Resize() \par 'on error resume next \par lblStatus.Width = Me.Width - 1500 \par cmdNext.Left = lblStatus.Width + 700 \par cmdLast.Left = cmdNext.Left + 340 \par End Sub \par \par \par \par Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) \par frmProducts1.Top = (Screen.Height - frmProducts1.Height) / 2 \par frmProducts1.Left = (Screen.Width - frmProducts1.Width) / 2 \par \par If mbEditFlag Or mbAddNewFlag Then Exit Sub \par \par \par \par Select Case KeyCode \par Case vbKeyEscape \par cmdClose_Click \par Case vbKeyEnd \par cmdLast_Click \par Case vbKeyHome \par cmdFirst_Click \par Case vbKeyUp, vbKeyPageUp \par \par \par If Shift = vbCtrlMask Then \par cmdFirst_Click \par Else \par cmdPrevious_Click \par End If \par Case vbKeyDown, vbKeyPageDown \par \par \par If Shift = vbCtrlMask Then \par cmdLast_Click \par Else \par cmdNext_Click \par End If \par End Select \par End Sub \par \par \par \par Private Sub Form_Unload(Cancel As Integer) \par Screen.MousePointer = vbDefault \par \par \par Form1.Show \par End Sub \par \par \par \par Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) \par 'This will display the current record po \par ' sition for this recordset \par lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition) \par End Sub \par \par \par \par Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) \par 'This is where you put validation code \par 'This event gets called when the followi \par ' ng actions occur \par Dim bCancel As Boolean \par \par \par \par Select Case adReason \par Case adRsnAddNew \par Case adRsnClose \par Case adRsnDelete \par Case adRsnFirstChange \par Case adRsnMove \par Case adRsnRequery \par Case adRsnResynch \par Case adRsnUndoAddNew \par Case adRsnUndoDelete \par Case adRsnUndoUpdate \par Case adRsnUpdate \par End Select \par \par If bCancel Then adStatus = adStatusCancel \par End Sub \par \par \par \par Private Sub cmdAdd_Click() \par On Error GoTo AddErr \par \par \par With adoPrimaryRS \par \par \par If Not (.BOF And .EOF) Then \par mvBookMark = .Bookmark \par End If \par .AddNew \par lblStatus.Caption = "Add record" \par mbAddNewFlag = True \par SetButtons False \par End With \par \par Exit Sub \par AddErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdDelete_Click() \par On Error GoTo DeleteErr \par \par \par With adoPrimaryRS \par .Delete \par .MoveNext \par If .EOF Then .MoveLast \par End With \par Exit Sub \par DeleteErr: \par MsgBox Err.Description \par End Sub \par \par \par \par Private Sub cmdRefresh_Click() \par 'This is only needed for multi user apps \par ' \par On Error GoTo RefreshErr \par adoPrimaryRS.Requery \par Exit Sub \par RefreshErr: \par MsgBox Err.Description \par End Sub \par \par Private Sub cmdEdit_Click() \par On Error GoTo EditErr \par \par lblStatus.Caption = "Edit record" \par mbEditFlag = True \par SetButtons False \par Exit Sub \par \par EditErr: \par MsgBox Err.Description \par End Sub \par \par \par Private Sub cmdCancel_Click() \par 'on error resume next \par \par SetButtons True \par mbEditFlag = False \par mbAddNewFlag = False \par adoPrimaryRS.CancelUpdate \par \par \par If mvBookMark > 0 Then \par adoPrimaryRS.Bookmark = mvBookMark \par Else \par adoPrimaryRS.MoveFirst \par End If \par mbDataChanged = False \par \par End Sub \par \par \par \par \cf1 Private Sub cmdUpdate_Click()\cf0 \par On Error GoTo UpdateErr \par \par adoPrimaryRS.UpdateBatch adAffectAll \par \par If mbAddNewFlag Then \par adoPrimaryRS.MoveLast 'move to the new record \par End If \par \par mbEditFlag = False \par mbAddNewFlag = False \par SetButtons True \par mbDataChanged = False \par \par Exit Sub \par UpdateErr: \par MsgBox Err.Description \par \cf1 End Sub\cf0 \par \par \par \par \cf1 Private Sub cmdClose_Click()\cf0 \par Unload Me \par \cf1 End Sub\cf0 \par \par \par \par \cf1 Private Sub cmdFirst_Click()\cf0 \par On Error GoTo GoFirstError \par \par adoPrimaryRS.MoveFirst \par mbDataChanged = False \par \par Exit Sub \par \par GoFirstError: \par MsgBox Err.Description \par \cf1 End Sub\cf0 \par \par \par \par \cf1 Private Sub cmdLast_Click()\cf0 \par On Error GoTo GoLastError \par \par adoPrimaryRS.MoveLast \par mbDataChanged = False \par \par Exit Sub \par \par GoLastError: \par MsgBox Err.Description \par \cf1 End Sub\cf0 \par \par \par \par \cf1 Private Sub cmdNext_Click()\cf0 \par On Error GoTo GoNextError \par \par If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext \par If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then \par Beep \par 'moved off the end so go back \par adoPrimaryRS.MoveLast \par End If \par 'show the current record \par mbDataChanged = False \par \par Exit Sub \par GoNextError: \par MsgBox Err.Description \par \cf1 End Sub\cf0 \par \par \par \cf1 Private Sub cmdPrevious_Click()\cf0 \par On Error GoTo GoPrevError \par If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious \par If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then \par Beep \par 'moved off the end so go back \par adoPrimaryRS.MoveFirst \par End If \par 'show the current record \par mbDataChanged = False \par \par Exit Sub \par \par GoPrevError: \par MsgBox Err.Description \par \cf1 End Sub\cf0 \par \par \cf1 Private Sub SetButtons(bVal As Boolean) \par \cf0 cmdAdd.Visible = bVal \par cmdEdit.Visible = bVal \par cmdUpdate.Visible = Not bVal \par cmdCancel.Visible = Not bVal \par cmdDelete.Visible = bVal \par cmdClose.Visible = bVal \par cmdRefresh.Visible = bVal \par cmdNext.Enabled = bVal \par cmdFirst.Enabled = bVal \par cmdLast.Enabled = bVal \par cmdPrevious.Enabled = bVal \par \cf1 End Sub\cf0 \par } |
ADO |
India web developer web development India | India web development company India ecommerce web developer