Private Sub frSortBy_DblClick(Cancel As Integer)
'On Error GoTo ErrorHandler
Select Case frSortBy
Case 1
Me![Age].Form.OrderBy = "Age" ' Sort by two fields.
Me![Age].Form.OrderBy = True
Case 2
Me.OrderBy = "HT" ' Sort by descending date.
Case 3
Me.OrderBy = "WT" ' Sort by two fields.
Case 4
Me.OrderBy = "Salary DESC" ' Sort by descending date.
End Select
Me.OrderByOn = True ' Apply the sort order.
'DoCmd.Requery
Exit Sub
'ErrorHandler:
' MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
Related
I have the problem that the combobox in access 2010 displays just 1249 values of the 1278. Is there a possibility to increase the max number of values in a combobox in access?
Here is a code sample:
If not rs.EOF Then
rs.MoveFirst
frm.FName.RowSource = ""
frm.FNameLux.RowSource = ""
Do Until rs.EOF
If rs![id] <> -1 And rs![id] <> -2 Then
If (rs!KID <> 2 And rs!KID <> 8) Then
If IsNull(rs![Name]) = False Then
frm.FName.AddItem rs![Name] & ";" & rs![id]
Debug.Print rs!Name 'The program writes all values in the combobox, but when I look in the form, I don't see all values
End If
End If
If (rs!KID = 2 Or rs!KID = 8) Then
If IsNull(rs![Name]) = False Then
frm.FNameLux.AddItem rs![Name] & ";" & rs![id]
End If
End If
End If
rs.MoveNext
i = i + 1
Loop
End If
rs is the recordset. Is there any idea how to solve it or what I have to do?
Apparently the RowSource property for RowSourceType = Value list is limited to 16bit integer length (2^15 = 32768) or a bit below.
Test code for a 2-column combobox:
Private Sub btValues_Click()
Dim i As Long
DoCmd.Hourglass True
Me.cboValues.RowSource = ""
For i = 1 To 5000
Me.cboValues.AddItem "Number " & Format(i, "0000") & ";" & i
Next i
DoCmd.Hourglass False
Debug.Print Len(Me.cboValues.RowSource)
End Sub
The combobox is filled up until "Number 1991", output is 32739.
So the problem is not the number of rows, but the total string length. If I shorten the text, it goes up to "Nr 2604" (32744 chars).
You'll have to use RowSourceType = Table/query to show all items.
Edit
Create queries as rowsource for the comboboxes. As far as I can see, there is nothing in your code that cannot be done in a WHERE clause.
E.g. for FName
SELECT Name, id
FROM yourTable
WHERE id <> -1 AND id <> -2
AND KID <> 2 AND KID <> 8
AND Name IS NOT NULL
If your VBA code could not be recreated in SQL, you'd have to insert the recordset rows you want into a temp table, and use this table as rowsource.
I would like to have a check-box that, when ticked, filters the loaded data to only include data where it has been at least one month until the "Expected pair maturation" date. Here is my attempt:
Private Sub LockFilter1Chk_Click()
If Me!LockFilter1Chk = True Then
Me.RecordSource = "SELECT * FROM staff " & _
WHERE DateDiff("m", Me![Expected pair maturation], Now()) > 1 "
End If
If Me!LockFilter1Chk = Not True Then
Me.RecordSource = "SELECT * FROM Staff "
End If
End Sub
It might be simple to set the Filter:
Private Sub LockFilter1Chk_Click()
If Me!LockFilter1Chk = True Then
Me.Filter = "[Expected pair maturation] < DateAdd("m", -1, Date())"
Me.FilterOn = True
Else
Me.FilterOn = False
End If
End Sub
After a string and line concatenation & _ you need a new double quote to start the new string.
If you have " inside a string, you must mask it as "".
In a SQL SELECT recordsource, don't refer to Me!. You are comparing the value from the table, so only use the field name.
Some indentation helps a lot with readability.
This should be closer (not sure if it already does what you want).
Private Sub LockFilter1Chk_Click()
If Me!LockFilter1Chk = True Then
Me.RecordSource = "SELECT * FROM staff " & _
"WHERE DateDiff(""m"", [Expected pair maturation], Now()) > 1 "
Else
Me.RecordSource = "SELECT * FROM Staff "
End If
End Sub
You did not mention what was your problem.
You can do it the way you did, but I would use an if then else construct:
Private Sub LockFilter1Chk_Click()
If Me!LockFilter1Chk = True Then
Me.RecordSource = "SELECT * FROM staff " & _
"WHERE [Expected pair maturation] < DateAdd('m', -1, Date())"
else
Me.RecordSource = "Staff"
End If
End Sub
Alternatively you could leave the record Source unchanged and use a filter:
If Me!LockFilter1Chk = True Then
docmd.applyfilter , "[Expected pair maturation] < DateAdd('m', -1, Date())"
else
me.filterOn = false
end if
Note: If you have quotes within quotes, you can also use single quotes inside:
"DateDiff('m', Me![Expected pair maturation], Now()) > 1 "
I have the code below in a click button event in MS Access 2013 form, whose datasource is from a query with the following fields “EnrNo, FirstName, LastName, and RegDate”.
The form has three text boxes and a command button:
txtKeyword
txtDateFrom
txtDateTo
cmdSearch
The click button (cmdSearch) in the form is intended to filter the query based on three criteria’s , which could be any of the two “EnrNo, FirstName, LastName” AND the range of the date(s) entered in the text box txtDateTo and cmdSearch
My code successfully filters only EnrNo. Please help me out... Thanks for your time.
Private Sub cmdSearch_Click()
Dim strWhere As String 'The criteria string.
Dim Where As String
Dim lngLen As Long 'Length of the criteria string to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates in a JET query string.
'Text field example. Use quotes around the value in the string.
If Not IsNull(Me.txtFilter) Then
strWhere = strWhere & "([EnrNo] = """ & Me.txtFilter & """) OR "
strWhere = strWhere & "([FirstName] = """ & Me.txtFilter & """) AND "
End If
'Date field example. Use the format string to add the # delimiters and get the right international format.
If Not IsNull(Me.txtFrom) Then
strWhere = strWhere & "([RegDate] >= " & Format(Me.txtFrom, conJetDate) & ") AND "
End If
'Another date field example. Use "less than the next day" since this field has times as well as dates.
If Not IsNull(Me.txtTo) Then 'Less than the next day.
strWhere = strWhere & "[RegDate] BETWEEN #" & Format(Me.txtFrom, "mm/dd/yyyy") & "# AND #" & Format(Me.txtTo, "mm/dd/yyyy") & "# "
End If
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the " AND " at the end.
strWhere = Left$(strWhere, lngLen)
'Debug.Print strWhere
Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
It displays “Run-time error ‘3075’: Syntax error in data in query expression ‘([EnrNo] = “MS-12/IT-004”) or ([FirstName] = “MS-12/IT-004”) AND ([RegDate] >= #06/16/2014#) AND [RegDate] BETWEEN #06/16/2014# AND #09/23/2’ you have too many operands here.
You will need to make it so your query's where statement is as follows;
(([EnrNo] = “MS-12/IT-004”) or ([FirstName] = “MS-12/IT-004”)) AND (([RegDate] >= #06/16/2014#) AND ([RegDate] BETWEEN #06/16/2014# AND #09/23/2014#))
Note the extra brackets I have placed in there. Logical operators (OR/AND) will return a value based upon TWO expressions. So for instance, a > b AND b > c returns true if BOTH conditions are true. a > b OR b > c returns true if EITHER statement is true.
If we write a statement like a > b and b > c or d > f we have too many conditions, so we need to nest them. So we would write it as (a > b AND b > c) OR d > f.
A good way to practice this is to create the query with the criteria manually in the query builder, then look at the bracketing placed on your conditions in the SQL view window of the query.
I hope this helps!
Im working with my project inventory system i want to display the filtered dates in my books table in the mysql in my listview1 using 2 DTPicker and make a report for it. Im having an error in my query in the classmodule idk if its only the query and im really confused im a begginer in vb 6.0...please in need your help guys.
Im using 2 tables namely books and supplier.
MY CODE IN THE 'CLASS MODULE':
Sub DisplayList(ListView1 As ListView, DateFrom As Date, DateTo As Date)
Dim lstItem As ListItem, a As Integer
Dim rs As New ADODB.Recordset
Dim sql As String
If rs.State = adStateOpen Then rs.Close
sql = " SELECT supplier.category,books.title,books.dataAcquired,books.amount,books.quantity,books.accesionno,books.conditions" & _
" From supplier INNER JOIN books" & _
" ON supplier.code=books.code" & _
" WHERE (((books.dataAcquired)>=#" & DateFrom & "#) and ((books.dataAcquired) <=#" & DateTo & "#))" & _
" GROUP BY supplier.category,books.title,books.dataAcquired,books.amount,books.quantity,books.accesionno,books.conditions" & _
" ORDER BY books.dataAcquired DESC;"
rs.Open sql, cnn
ListView1.ListItems.Clear
Do While Not rs.EOF
a = a + 1
Set lstItem = ListView1.ListItems.Add(, , a, 1, 1)
lstItem.SubItems(1) = rs(0).Value
lstItem.SubItems(2) = rs(1).Value
lstItem.SubItems(3) = rs(2).Value
lstItem.SubItems(4) = rs(3).Value
lstItem.SubItems(5) = rs(4).Value
lstItem.SubItems(6) = rs(5).Value
lstItem.SubItems(7) = rs(6).Value
rs.MoveNext
Loop
End Sub
MY CODE IN MY FORM:
Private Sub Show_Click()
clsData.DisplayList ListView1, DTPicker1.Value, DTPicker2.Value
lblCount.Caption = ListView1.ListItems.Count
End Sub
Private Sub Form_Load()
DTPicker1.Value = Date
DTPicker2.Value = Date
End Sub
Private Sub Form_Activate()
clsData.DisplayList ListView1, DTPicker1.Value, DTPicker2.Value
lblCount.Caption = ListView1.ListItems.Count
End Sub
Change # by '
format date how yyyy-MM-dd or yyyyMMdd
sql = " SELECT supplier.category,books.title,books.dataAcquired,books.amount,books.quantity,books.accesionno,books.conditions" & _
" From supplier INNER JOIN books" & _
" ON supplier.code=books.code" & _
" WHERE (((books.dataAcquired)>='" & format(DateFrom,"yyyy-MM-dd") & "') and ((books.dataAcquired) <='" & format(DateTo,"yyyy-MM-dd") & "'))" & _
" GROUP BY supplier.category,books.title,books.dataAcquired,books.amount,books.quantity,books.accesionno,books.conditions" & _
" ORDER BY books.dataAcquired DESC;"
change loop while added validations for recordset emptys, some how
if RecordsetIsClosed(rs) then exit sub
While Not RecordSetIsEmpty(rs)
a = a + 1
Set lstItem = ListView1.ListItems.Add(, , a, 1, 1)
lstItem.SubItems(1) = rs(0).Value
lstItem.SubItems(2) = rs(1).Value
lstItem.SubItems(3) = rs(2).Value
lstItem.SubItems(4) = rs(3).Value
lstItem.SubItems(5) = rs(4).Value
lstItem.SubItems(6) = rs(5).Value
lstItem.SubItems(7) = rs(6).Value
rs.MoveNext
wend
Public Function RecordSetIsEmpty(ByRef rs As ADODB.Recordset) As Boolean
' On Local Error GoTo RecordSetIsEmpty_Error
' RecordSetIsEmpty = True
' If rs Is Nothing Then
' RecordSetIsEmpty = True
' Exit Function
' End If
' If RecordsetIsClosed(rs) = True Then
' RecordSetIsEmpty = True
' Exit Function
' End If
RecordSetIsEmpty = (rs.BOF = True And rs.EOF = True)
' RecordSetIsEmpty_Done:
' Exit Function
' RecordSetIsEmpty_Error:
' Resume RecordSetIsEmpty_Done
End Function
Public Function RecordsetIsClosed(ByRef rs As ADODB.Recordset) As Boolean
On Local Error GoTo RecordsetIsClosed_Error
RecordsetIsClosed = True
If rs Is Nothing Then
RecordsetIsClosed = True
End If
If rs.State <> adStateClosed Then
RecordsetIsClosed = False
End If
RecordsetIsClosed_Done:
Exit Function
RecordsetIsClosed_Error:
Resume RecordsetIsClosed_Done
End Function
Dont forget to open the database connection
updated thanks Mark Bertenshaw
RecordSetIsEmpty is use for problems when do movenext.. well i remember
RecordsetIsClosed is use because in some cases and databases managers return not recordset or the recordset is not correct initialized
for example access is necessary use movefist before do movenext or read values
I have a form which displays companies and a subform which displays contacts. There are multiple contacts per company.
I have a filter which works off of a combo box, which selects companies only where they have contacts with the selected responsibility;
Sub SetFilter()
Dim ASQL As String
If IsNull(Me.cboshowcat) Then
' If the combo and all check boxes are Null, use the whole table as the
' RecordSource.
Me.RecordSource = "SELECT company.* FROM company"
Else
ASQL = "SELECT DISTINCTROW company.* " & _
"FROM company INNER JOIN Contacts " & _
"ON company.company_id = Contacts.company_id " & _
"WHERE Contacts.responsibility= '" & cboshowcat & "' " & _
"ORDER BY Company.company_id"
Me.RecordSource = ASQL
End If
End Sub
I also have 3 checkboxes which further refine the records which can only be used once a job responsibility has been selected. The filter and checkboxes are ran after clicking a button;
Private Sub Command201_Click()
If Nz(Me.cboshowcat) = "" _
And Me.Check194 = True _
Or Nz(Me.cboshowcat) = "" _
And Me.Check199 = True _
Or Nz(Me.cboshowcat) = "" _
And Me.Check205 = True _
Then
MsgBox "Please Select a Job Responsibility"
Cancel = True
Else
SetFilter
If Me.Check194 = True _
And Me.Check199 = True _
And Me.Check205 = True _
Then
Me.Filter = "[contacts].[edit] <=Date()-90 " & _
"and [contact].[opt out]='No' " & _
"and [company].[exclude site] is null"
Me.FilterOn = True
Else
If Me.Check194 = True _
And Me.Check199 = True _
And Me.Check205 = False _
Then
Me.Filter = "[contacts].[edit] <=Date()-90 " & _
"and [contact].[opt out]='No'"
Me.FilterOn = True
Else
'................(repeated for each combination)
Me.Filter = ""
Me.FilterOn = False
End If
End If
End If
End If
End If
End If
End If
End If
Me.Repaint
End Sub
The above query does not work as it does not find the field name that I am referencing in the contact table. If I include the field in the filter query select statement it does work, however it shows me multiple instances of each company depending on how many contacts are returned for each company.
I need to filter the companies based on information in contact table without duplicating the company information.
If someone knows how to get around this problem I would be very grateful.
First some style things:
1) You probably have less nesting if you use ElseIf instead of
Else
If '...
2) It would be good form to re-name the check boxes something more meaningful that Check194 (at least for the next developer who touches this code - even if that is you 4 years down the line). That is, of course, assuming that this is not a contrived example to anonymise the code a little bit.
3) Like wise having space in column and table names can be a pain in the butt. Likewise "Edit" looks like a reserved word (it may not be), and can lead to heart break.
4) I'm not sure of the logic of your 1st IF statement. You may not have the order of operation may not be what you expect. It's basically the equivalent of
If Nz(Me.cboshowcat) = "" _
And (Me.Check194 = True _
Or Me.Check199 = True _
Or Me.Check205 = True) _
then
If that's what you wanted, then it is fine.
5) If you build up the filter string on the fly, you won't have to go through al eight combinations (and perhaps miss one). Imagine if you had 4, 5 or 10 check boxes. Typically, I would do something like this
dim strFilter as string
strFilter = "(1 = 1) " ' so we don't have to decide whether to put `and` or not.
If Nz(Me.cboshowcat) = "" then
if Me.Check194 = then
strFilter = strFilter & "and [contacts].[edit] <=Date()-90 "
end if
if Me.Check199 = then
strFilter = strFilter & "and [contacts].[opt out]='No' "
end if
if Me.Check199 = then
strFilter = strFilter & "and [company].[exclude site] is null "
end if
me.filter = strFilter
me.filteron = true
else
me.filter = ""
me.filteron = false
end if
Second the solution to your problem:
The multiple rows for each company are because of the join, and the query is now forced to show a row for each contact with a different combination of values for "Edit" or "Opt out".
Since you are already updating the record source on the fly, I'd just shove the filter into the where clause of the record source and be done with it. That's effectively what the filter is doing anyway (only on the result of the query, that's why it can't see into the contacts table).
Again, build up the where clause on the fly, instead of doing 8 different combinations.