Hi all,
I have this project to use the ADODB control to acces and manipulate the
Access DB. I amd the mistake of first doing this project with just the data
control. It worked fine with this control. I adjusted a few things and can
get the ADODB controlto move through the records of the DB, but my menu
controls do not work. I used them to look up certain records through
various criteria. When I click on the lookup, it brings up the box to enter
a letter to find the record but does not find the record and the ADODB
button becomes inactive. I left the button name as dtaAddress, but it is
really an adoAddress. Another funny thing is when I tried to chand the name
of dtaAddress to adoAdress the ADODB control would become inactive then. I
am now trying to get the menu control to work with ADODB I think it has to
do with th refresh method you see in my code, but when I try to change it to
requery, I get an error message. Any help would be greatly appreciated.
Regards,
Kelsey
Option Explicit
Private conn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Command1_Click()
End Sub
Private Sub cmdSave_Click()
'when the user clicks the save button, call
'File|Save. (To jump to this procedure, select 'mnufilesave_click' and
press Shift+F2.)
mnuFileSave_Click
End Sub
Private Sub dtaAddress_Reposition()
Dim X As Integer, NewRec As Integer
If dtaAddress.EditMode = 2 Then ' You're editing a new record.
mnuFileSave.Enabled = True
'disable add, delete menu items
For X = 0 To 1: mnuRecSub(X).Enabled = False: Next X
Else
mnuFileSave.Enabled = False
For X = 0 To 1: mnuRecSub(X).Enabled = True: Next X
End If
cmdSave.Enabled = mnuFileSave.Enabled
If dtaAddress.Recordset.BOF Then
Beep
mnuRecSub(4).Enabled = False
ElseIf dtaAddress.Recordset.EOF Then
Beep
mnuRecSub(5).Enabled = False
Else
For X = 3 To 6: mnuRecSub(X).Enabled = True: Next X
End If
End Sub
Private Sub Form_Load()
Center Me
lblAddrId.BackColor = txtAddress(1).BackColor
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub mnuFileExit_Click()
End
End Sub
Private Sub mnuFileSave_Click()
dtaAddress.UpdateRecord
End Sub
Private Sub mnuLookSub_Click(Index As Integer)
Dim Prompt As String, Title As String, Default As String, l As Integer
Dim Sought As String, Field As String, SQL As String
Dim MyCriteria As String
Select Case Index
Case Is < 5
Prompt = Mid$(mnuLookSub(Index).Caption, 4) 'strip out leading "by "
l = InStr(Prompt, "&")
If l <> 0 Then Prompt = Left$(Prompt, l - 1) & Mid$(Prompt, l + 1)
Title = "Search by " & Prompt
Prompt = "Enter all or part of the " & Prompt & " to search for:"
Default = ""
Sought = InputBox(Prompt, Title, Default)
If Sought = "" Then Exit Sub
Select Case Index
Case 0: Field = "Lastname"
Case 1: Field = "Firstname"
Case 2: Field = "Company"
Case 3: Field = "City"
Case 4: Field = "State"
End Select
SQL = "Select * from Addresses where " & Field & " LIKE '" & Sought
& "*'"
Debug.Print SQL
dtaAddress.RecordSource = SQL
dtaAddress.Refresh'<----------here
Case 5
End Select
End Sub
Private Sub mnuRecSub_Click(Index As Integer)
Select Case Index
Case 0 'add
dtaAddress.Recordset.AddNew
txtAddress(1).SetFocus
Case 1 ' delete
If MsgBox("Delete this Record?", vbQuestion + vbYesNo) = vbYes
Then dtaAddress.Recordset.Delete
dtaAddress.Recordset.MovePrevious
Case 3 ' first
dtaAddress.Recordset.MoveFirst
Case 4 ' previous
dtaAddress.Recordset.MovePrevious
If dtaAddress.Recordset.BOF Then
Beep
dtaAddress.Recordset.MoveFirst
End If
Case 5 ' next
dtaAddress.Recordset.MoveNext
If dtaAddress.Recordset.EOF Then
Beep
dtaAddress.Recordset.MoveLast
End If
Case 6 ' last
dtaAddress.Recordset.MoveLast
End Select
End Sub
Private Sub txtAddress_Change(Index As Integer)
mnuFileSave.Enabled = True
cmdSave.Enabled = True
End Sub
Private Sub txtAddress_GotFocus(Index As Integer)
Sel txtAddress(Index)
End Sub
Private Sub txtAddress_LostFocus(Index As Integer)
Dim Temp As String
If Index = 10 Or Index = 11 Or Index = 13 Then
If txtAddress(8) = "USA" And txtAddress(Index).Text Like
"##########" Then
Temp = "(" & Left$(txtAddress(Index), 3) & ") "
Temp = Temp & Mid$(txtAddress(Index), 4, 3) & "-"
Temp = Temp & Mid$(txtAddress(Index), 7)
txtAddress(Index) = Temp
End If
End If
End Sub
'Then the added module
Option Explicit
Public Sub Center(f As Form)
f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 2
End Sub
Public Sub Sel(c As Control)
If TypeOf c Is TextBox Then
c.SelStart = 0
c.SelLength = Len(c)
End If
End Sub
Sub Stat(Msg As String)
If frmMain.lblStatus <> Msg Then frmMain.lblStatus = Msg
End Sub
