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.Connectio n
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_cl ick' and
press Shift+F2.)
mnuFileSave_Cli ck
End Sub
Private Sub dtaAddress_Repo sition()
Dim X As Integer, NewRec As Integer
If dtaAddress.Edit Mode = 2 Then ' You're editing a new record.
mnuFileSave.Ena bled = True
'disable add, delete menu items
For X = 0 To 1: mnuRecSub(X).En abled = False: Next X
Else
mnuFileSave.Ena bled = False
For X = 0 To 1: mnuRecSub(X).En abled = True: Next X
End If
cmdSave.Enabled = mnuFileSave.Ena bled
If dtaAddress.Reco rdset.BOF Then
Beep
mnuRecSub(4).En abled = False
ElseIf dtaAddress.Reco rdset.EOF Then
Beep
mnuRecSub(5).En abled = False
Else
For X = 3 To 6: mnuRecSub(X).En abled = True: Next X
End If
End Sub
Private Sub Form_Load()
Center Me
lblAddrId.BackC olor = txtAddress(1).B ackColor
End Sub
Private Sub Form_Unload(Can cel As Integer)
End
End Sub
Private Sub mnuFileExit_Cli ck()
End
End Sub
Private Sub mnuFileSave_Cli ck()
dtaAddress.Upda teRecord
End Sub
Private Sub mnuLookSub_Clic k(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.Reco rdSource = SQL
dtaAddress.Refr esh'<----------here
Case 5
End Select
End Sub
Private Sub mnuRecSub_Click (Index As Integer)
Select Case Index
Case 0 'add
dtaAddress.Reco rdset.AddNew
txtAddress(1).S etFocus
Case 1 ' delete
If MsgBox("Delete this Record?", vbQuestion + vbYesNo) = vbYes
Then dtaAddress.Reco rdset.Delete
dtaAddress.Reco rdset.MovePrevi ous
Case 3 ' first
dtaAddress.Reco rdset.MoveFirst
Case 4 ' previous
dtaAddress.Reco rdset.MovePrevi ous
If dtaAddress.Reco rdset.BOF Then
Beep
dtaAddress.Reco rdset.MoveFirst
End If
Case 5 ' next
dtaAddress.Reco rdset.MoveNext
If dtaAddress.Reco rdset.EOF Then
Beep
dtaAddress.Reco rdset.MoveLast
End If
Case 6 ' last
dtaAddress.Reco rdset.MoveLast
End Select
End Sub
Private Sub txtAddress_Chan ge(Index As Integer)
mnuFileSave.Ena bled = True
cmdSave.Enabled = True
End Sub
Private Sub txtAddress_GotF ocus(Index As Integer)
Sel txtAddress(Inde x)
End Sub
Private Sub txtAddress_Lost Focus(Index As Integer)
Dim Temp As String
If Index = 10 Or Index = 11 Or Index = 13 Then
If txtAddress(8) = "USA" And txtAddress(Inde x).Text Like
"########## " Then
Temp = "(" & Left$(txtAddres s(Index), 3) & ") "
Temp = Temp & Mid$(txtAddress (Index), 4, 3) & "-"
Temp = Temp & Mid$(txtAddress (Index), 7)
txtAddress(Inde x) = 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.lblStat us <> Msg Then frmMain.lblStat us = Msg
End Sub
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.Connectio n
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_cl ick' and
press Shift+F2.)
mnuFileSave_Cli ck
End Sub
Private Sub dtaAddress_Repo sition()
Dim X As Integer, NewRec As Integer
If dtaAddress.Edit Mode = 2 Then ' You're editing a new record.
mnuFileSave.Ena bled = True
'disable add, delete menu items
For X = 0 To 1: mnuRecSub(X).En abled = False: Next X
Else
mnuFileSave.Ena bled = False
For X = 0 To 1: mnuRecSub(X).En abled = True: Next X
End If
cmdSave.Enabled = mnuFileSave.Ena bled
If dtaAddress.Reco rdset.BOF Then
Beep
mnuRecSub(4).En abled = False
ElseIf dtaAddress.Reco rdset.EOF Then
Beep
mnuRecSub(5).En abled = False
Else
For X = 3 To 6: mnuRecSub(X).En abled = True: Next X
End If
End Sub
Private Sub Form_Load()
Center Me
lblAddrId.BackC olor = txtAddress(1).B ackColor
End Sub
Private Sub Form_Unload(Can cel As Integer)
End
End Sub
Private Sub mnuFileExit_Cli ck()
End
End Sub
Private Sub mnuFileSave_Cli ck()
dtaAddress.Upda teRecord
End Sub
Private Sub mnuLookSub_Clic k(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.Reco rdSource = SQL
dtaAddress.Refr esh'<----------here
Case 5
End Select
End Sub
Private Sub mnuRecSub_Click (Index As Integer)
Select Case Index
Case 0 'add
dtaAddress.Reco rdset.AddNew
txtAddress(1).S etFocus
Case 1 ' delete
If MsgBox("Delete this Record?", vbQuestion + vbYesNo) = vbYes
Then dtaAddress.Reco rdset.Delete
dtaAddress.Reco rdset.MovePrevi ous
Case 3 ' first
dtaAddress.Reco rdset.MoveFirst
Case 4 ' previous
dtaAddress.Reco rdset.MovePrevi ous
If dtaAddress.Reco rdset.BOF Then
Beep
dtaAddress.Reco rdset.MoveFirst
End If
Case 5 ' next
dtaAddress.Reco rdset.MoveNext
If dtaAddress.Reco rdset.EOF Then
Beep
dtaAddress.Reco rdset.MoveLast
End If
Case 6 ' last
dtaAddress.Reco rdset.MoveLast
End Select
End Sub
Private Sub txtAddress_Chan ge(Index As Integer)
mnuFileSave.Ena bled = True
cmdSave.Enabled = True
End Sub
Private Sub txtAddress_GotF ocus(Index As Integer)
Sel txtAddress(Inde x)
End Sub
Private Sub txtAddress_Lost Focus(Index As Integer)
Dim Temp As String
If Index = 10 Or Index = 11 Or Index = 13 Then
If txtAddress(8) = "USA" And txtAddress(Inde x).Text Like
"########## " Then
Temp = "(" & Left$(txtAddres s(Index), 3) & ") "
Temp = Temp & Mid$(txtAddress (Index), 4, 3) & "-"
Temp = Temp & Mid$(txtAddress (Index), 7)
txtAddress(Inde x) = 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.lblStat us <> Msg Then frmMain.lblStat us = Msg
End Sub