I'm trying to create a search box that acts like the navigation search function at the bottom of the page in access. This is so the users of my data base have an easier time navigating the database.
My code currently is
Private Sub cmdSearch_Click()
Dim bkmk As Variant
Dim strField As String
Me.RecordsetClone.MoveFirst
'Find the first record that matches what
'is in the search text box.
Me.RecordsetClone.FindFirst "B3 Like " _
& Chr(34) & Me.txtsearch & "*" & Chr(34) _
& "OR Item Like" _
& Chr(34) & Me.txtsearch & "*" & Chr(34) _
If Me.RecordsetClone.NoMatch Then
MsgBox "No Match"
Else
bkmk = Me.RecordsetClone.Bookmark
Me.Recordset.Bookmark = bkmk
End If
End Sub
When I apply this code to my search function even when I'm testing with an item that is known to be in the database it is returning the "No Match" message box. My end goal is to have a search function that will search multiple fields in the back end table.
Related
I try to find a folder in an Outlook account (I use Multiple accounts) using VBA and Redemption by using the FIND method but I cannot get it to work. On the Redemption webpage there is a reference made to an example and this may help but unfortunately the example isn't there.
Here's my code so far:
Public Function FindFolderRDO(strCrit As String) As String
If Not TempVars![appdebug] Then On Error GoTo Err_Proc
Dim objRdoSession As Redemption.RDOSession
Dim objRdoFolder As RDOFolder
Dim strFoundFolder As String
Dim objFoundFolder As RDOFolder
Dim strFolderName As String
Set objRdoSession = CreateObject("Redemption.RDOSession")
objRdoSession.Logon
objRdoSession.MAPIOBJECT = Outlook.Session.MAPIOBJECT
strFolderName = "\\[mailbox name]\[foldername]\[foldername]" 'actual names removed
Set objRdoFolder = objRdoSession.GetFolderFromPath(strFolderName)
Debug.Print objRdoFolder.Parent.Name 'Prints the folder name
Set objFoundFolder = objRdoFolder.Folders.Find("LIKE 'strCrit%' ") 'Does not work
Debug.Print objFoundFolder.Name
strFoundFOlder = objRdoFolder.Folders.Find("LIKE 'strCrit%' ") 'Does not work
Debug.Print strFoundFOlder
Exit_Proc:
On Error Resume Next
Set objRdoFolder = Nothing
Set objRdoSession = Nothing
Set objFoundFolder = Nothing
Exit Function
Err_Proc:
Select Case Err.Number
Case Else
MsgBox "Error: " & CStr(Err.Number) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Library: " & Application.CurrentProject.Name & vbCrLf & _
"Module: Mod_RDO" & vbCrLf & _
"Function: FindFolderRDO" & vbCrLf, _
vbCritical, "Error"
End Select
Resume Exit_Proc
End Function
Purpose of this function is to find a subfolder (can be up to 4 dimensions deep) having an unique case number of 6 numbers (for example "200332") on the first 6 positions. This function should provide NULL if not found or the full path and the name of the found folder.
I can create the full path with a seperate function (calling the parent folder until top level) but maybe there is a procedure in Redemption such as "fullpath" which I overlooked.
Eventually I want to use this function to delete, move or rename the mailbox folder.
My main question is how to use the "Find(Filter)" method. But any reply on the full path is welcome as well.
Thx! Art.
You are you trying to find a suborder with a name that starts with "strCrit"?
You are almost there:
Set objFoundFolder = objRdoFolder.Folders.Find("Name LIKE 'strCrit%' ")
First off I am a bit of a novice when its comes to VBA, so everything I do is a bit of hit and miss but normally I eventually figure out the problem.
However this time I have been stuck for days and can't seem to find the issue!
I have the following form and subforms with the below structure. (Access2013)
Main Form [Job Number]
Subform [Out2] (this is where a user scans a barcode into the relevant field)
Subform [DS] (this is where the scanned barcode from [Out2] creates a new record)
Subform [DS] fields : Id, Job No, BarCode, Description, Date, User
What I am trying to achieve with the code below, is in 'The Before Update' event of the [DS] BarCode field, the Dcount function will check the list of Barcodes already entered in the subform container [DS], and if there
is more than one it will undo the duplicate entry. Unfortunately nothing is happening when a duplicate entry is entered.
(not even errors)
P.S. Setting the table (No Duplicates) thing will not work for this DB.
Private Sub BarCode_BeforeUpdate(Cancel As Integer)
Dim BarCode As String
Dim strLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
BarCode = Me.BarCode.Text
strLinkCriteria = "[Barcode]=" & "'" & Replace(Me![BarCode], "'", "''")
'Check Items Subform for duplicate BarCode
If DCount("BarCode", "Forms![Job Number]![DS]", strLinkCriteria) > 0 Then
'Undo duplicate entry
Me.Undo
'Message box warning of duplication
MsgBox "Warning Item Title " _
& BarCode & " has already been entered." _
& vbCr & vbCr & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
'Go to record of original Title
rsc.FindFirst strLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
Here is how to handle this:
Private Sub BarCode_BeforeUpdate(Cancel As Integer)
Dim rsc As DAO.Recordset
Dim BarCode As String
Dim Criteria As String
Set rsc = Me.RecordsetClone
BarCode = Nz(Me!BarCode.Value)
Criteria = "[Barcode] = '" & Replace(BarCode, "'", "''") & "'")
rsc.FindFirst Criteria
Cancel = Not rsc.NoMatch
If Cancel = True Then
' Message box warning of duplication
MsgBox "Warning Item Title " _
& BarCode & " has already been entered." _
& vbCrLf & vbCrLf & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
' Go to record of original Title
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
I cant get the syntax right for a msgbox. I want the box to say:
You have indicated that"
"employee name" (a range reference to a cell the worksheet)
has worked for "hours" (a range reference to a cell the worksheet) doing "job" (a range reference to a cell the worksheet)
Is this information correct?
This is what I have (shortened slightly):
Public confirmation_yes_no()
Dim yesornoanswertomessagebox As String
Dim questiontomessagebox As String
questiontomessagebox = "You have indicated that" & worksheets("dept 1 input").range("g12"),"worked at" & worksheets("dept 1 input").range("g16"), "for" & worksheets("dept 1 input").range("g16"), vbinformation, "Are you sure that this data is correct?"
yesornoanswertomessagebox = MsgBox(questiontomessagebox, vbYesNo, "FlightPlan for Profits PRO")
If yesornoanswertomessagebox = vbNo Then
MsgBox "Return to Data Input to correct error(s)", 0, "FlightPlan for Profits PRO"
Else
MsgBox "Great! Press Enter", 0, "FlightPlan for Profits PRO"
End If
End Sub
I am assuming, of course, that this is possible.
Couple of things with your code,
The opening line of your sub, Public confirmation_yes_no(), what is it, is it a sub, function or what, the way it's written right now it is a global variable declaration.
When combining elements into one like with your string, always use & but be sure to manually put spaces around it, otherwise it is not recognized. &var1 <> & var1
Be cautious when setting the arguments in a variable to be used later and definitely don't set them twice.
If you use a qualifier a lot, like Worksheets("dept 1 input"), consider using a With statement like below, this saves you from having to type the bit on the With statement over and over. Please note that to make use of the with statement, you write . in front of the code..Range(... points to the sheet which is set by the With statement.Range(... points to the sheet which Excel considers to be active.
When combining variables with text, take into account that the variables most likely do not have leading and trailing spaces, and that you'll have to compensate for this in the string bits.
for readability you can add an _ to your code to indicate it continues on the next line instead of having a very, very long line.
You can use a message box directly in an If statement.
Corrected code
Public Sub confirmation_yes_no()
Dim questiontomessagebox As String
With ThisWorkbook.Worksheets("dept 1 input")
questiontomessagebox = "You have indicated that " & .Range("G12") & " worked at " _
& .Range("G16") & " for " & .Range("G16") & "." _
& vbCr & vbCr _
& "Are you sure that this data is correct?"
End With
If MsgBox(questiontomessagebox, vbYesNo, "FlightPlan for Profits PRO") = vbNo Then
MsgBox "Return to Data Input to correct error(s)", 0, "FlightPlan for Profits PRO"
Else
MsgBox "Great! Press Enter", 0, "FlightPlan for Profits PRO"
End If
End Sub
Hi you missed the "&" signs. So i Correct it for you.
questiontomessagebox = ("You have indicated that " & Worksheets("dept 1 input").Range("g12") & " ,worked at " _
& Worksheets("dept 1 input").Range("g16") & " for " & Worksheets("dept 1 input").Range("g16")) & Chr(32) & _
vbInformation & vbNewLine & " Are you sure that this data is correct?"
Completely new to VBA and need help with detailed instructions (dummy version for me).
I have a table with various columns and the following columns, specifically:
ReviewerComments
NewComment
I created a form with both of these fields and need to create an Append Comment button that moves the text from NewComment field and appends it to ReviewerComment field and time/date stamps the comments as they are added. I named this button cmdAppendComment.
I had seen someone else post something and I tried, but as I am completely new to this I know I messed it up. Any help is greatly appreciated.
This is what the VBA code looks like right now:
Private Sub cmdAppendComment_Click()
If (IsNull(NewComment.Value)) Then
MsgBox ("Please provide a comment before clicking" & _
"on the Append Comment button.")
Exit Sub
End If
If (IsNull(ReviewerComments.Value)) Then
ReviewerComments.Value = NewComment.Value & " ~ " & _
VBA.DateTime.Date & " ~ " & VBA.DateTime.Time
Else
ReviewerComments.Value = ReviewerComments.Value & _
vbNewLine & vbNewLine & _
NewComment.Value & " ~ " & _
VBA.DateTime.Date & " ~ " & VBA.DateTime.Time
End If
NewComment.Value = ""
End Sub
I have some suggestions for your code:
1. Do not check if a textbox is null but how many characters your textbox has. You should always do it that way because otherwise you tend to get errors.
If (len(Me.NewComment.Value & "") > 0) Then
MsgBox ("Please provide a comment before clicking" & _
"on the Append Comment button.")
Exit Sub
End If
Here you check the length of the string in your textbox. You need to append "" because otherwise you tend to get null-errors or something similar.
2. You forgot to reference the objects in your form correctly. You have your form and in that form you put your textboxes and also your VBA-code. Your can reference all your objects with "Me.[FormObjects]".
The compiler complains that "NewComment.Value" or "ReviewerComment.Value" is not initialized or in other words not dimensioned. With correct reference this should stop.
Private Sub cmdAppendComment_Click()
If (len(Me.NewComment.Value & "") > 0) Then
MsgBox ("Please provide a comment before clicking" & _
"on the Append Comment button.")
Exit Sub
End If
If (IsNull(Me.ReviewerComments.Value)) Then
Me.ReviewerComments.Value = Me.NewComment.Value & " ~ " & _
VBA.DateTime.Date & " ~ " & VBA.DateTime.Time
Else
Me.ReviewerComments.Value = Me.ReviewerComments.Value & _
vbNewLine & vbNewLine & _
Me.NewComment.Value & " ~ " & _
VBA.DateTime.Date & " ~ " & VBA.DateTime.Time
End If
Me.NewComment.Value = ""
End Sub
I have a form which allows the user to view all records with the LinkRef field equal to a specified value and also either the Clearance Applying For or Clearance Level a certain value.
LinkRef is a user ID which is pulled in using OpenArgs from the previous form. The code for the form_load I have presently is:
Private Sub Form_Load()
'MsgBox Me.OpenArgs
Me.C_LinKRef = Me.OpenArgs
Me.chbToggleEdit.Value = False
'MsgBox Me.C_LinKRef
Dim mySQL As String
mySQL = _
"Select * " & _
"From TabClearDetail " & _
"Where (C_LinKRef = " & Me.C_LinKRef & ") " & _
"And ([Clearance Applying For] = 'BPSS' " & _
"Or [Clearance Applying For] = 'BPSS (EDF)' " & _
"Or [Clearance Applying For] = 'BPSS (Magn)' " & _
"Or [Clearance Applying For] = 'BPSS (Sella)' " & _
"Or [Clearance Applying For] = 'BPSS Equiv' " & _
"Or C_ClearanceLevel = 'BPSS' " & _
"Or C_ClearanceLevel = 'BPSS (EDF)' " & _
"Or C_ClearanceLevel = 'BPSS (Magn)' " & _
"Or C_ClearanceLevel = 'BPSS (Sella)' " & _
"Or C_ClearanceLevel = 'BPSS Equiv' " & _
"Or C_ClearanceLevel = 'DESTROYED' " & _
"Or C_ClearanceLevel = 'Lapsed' " & _
"Or C_ClearanceLevel = 'NOT_FLWDUP' " & _
"Or C_ClearanceLevel = 'NOT_SPECIFIED' " & _
"Or C_ClearanceLevel = 'Refused' " & _
"Or C_ClearanceLevel = 'Withdrawn');"
Me.RecordSource = mySQL
'MsgBox Me.RecordsetClone.RecordCount
End Sub
mySQL seems to behave as it should when there are matching records. But sometimes there won't be any records because the specified person doesn't have any of these clearance levels and hasn't applied for them, then I would like the form to come up blank or a message to appear saying that there is no matching records.
Presently though if there is no matching records the form will pull in the LinkRef but fill all the other text boxes with values from a completely different record (it seems to be the last record I viewed). Not to sure how to remedy this, I tried to use the RecordsetClone.RecordCount to say if it is equal to 0 then msgbox, but it seems to late to do that as it always seems to find at least 1 entry, as even if there should be 0 it has already populated the textboxes with data from another field so 1 is found.
The LinkRef textbox is populated from OpenArgs. All other textboxes are populated using a query which looks in the TabClearDetail table and pulls the values in. I'm starting to think I'd be better either just using Queries or just using Code, but I wasn't sure how to use OpenArgs in a query and for some things it's so much quicker to make a query than code.
Here is the code for my save dialog I refer to in reply to #Roland post. This code is called in the Form_Close() sub.
Private Sub SaveDialog()
Dim Msg, Style, Title As String
Dim Response As Integer
Msg = "Would you like to save your changes?"
Style = vbYesNoCancel
Title = "Save Changes"
On Error GoTo Err_BackFromAddBPSSButton_Click
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
'DoCmd.Close
DoCmd.OpenForm ("Basic Personal Information")
Else
If Response = vbNo Then
Me.Undo
'DoCmd.Close
DoCmd.OpenForm ("Basic Personal Information")
End If
End If
Exit_BackFromAddBPSSButton_Click:
Exit Sub
Err_BackFromAddBPSSButton_Click:
MsgBox Err.Description
Resume Exit_BackFromAddBPSSButton_Click
End Sub
Apologies for the very wordy question, hopefully all the detail is necessary and it makes sense, any suggestions HUGELY appreciated!
Try changing the order of events:
Don't set the TextBox value first. Pass the OpenArgs to the mySql string. With mySql open a recordset in VBA (OpenRecordset) and do a RecordCount. If it is zero then set the Recordsource to SELECT * FROM TabClearDetail WHERE 1=2 . Else set mySQl as the Recordsource (or pass the Recordset). Only then set the TextBox and CheckBox.
Private Sub Form_Load()
Dim i as Integer
i = Me.OpenArgs
Dim mySQL As String
mySQL = _
"Select * " & _
"From TabClearDetail " & _
"Where (C_LinKRef = " & Me.C_LinKRef & ") " & _
"And ([Clearance Applying For] IN ('BPSS','BPSS (EDF)','BPSS (Magn)','BPSS Sella)','BPSS Equiv') " & _
"Or C_ClearanceLevel IN ('BPSS','BPSS (EDF)','BPSS (Magn)','BPSS (Sella)','BPSS Equiv','DESTROYED','Lapsed','NOT_FLWDUP','NOT_SPECIFIED','Refused','Withdrawn'));"
Dim rst as Recordset
Set rst = CurrentDB.OpenRecordset(mySQL)
rst.MoveLast
rst.MoveFirst
If rst.RecordCount = 0 then
Me.RecordSource = "SELECT * FROM TabClearDetail WHERE 1=2"
Me.C_LinKRef = ""
Me.chbToggleEdit.Value = False
Else
Me.RecordSource = mySQL
Me.C_LinKRef = i
Me.chbToggleEdit.Value = False
End If
rst.Close
Set rst = Nothing
End Sub
Sorry, cannot test it here so may be a little buggy. If any problems I will check tomorrow
Using a query and passing [Forms]![BPSS Clearance].[OpenArgs] into that as well as the conditions on C_ClearanceLevel and Clearance Applying For has worked for me. No idea why the code didn't work because in theory it's doing the same thing, but I've got a solution so I'm happy. Thanks for all the suggestions