I've tried using DCOUNT and SQL and nothing is working. I've pasted both queries below. When I run the SQL nothing appears in the listbox. When I run the DLOOKUP I get the error message "Run-time error '2001": You canceled the previous operation. The combobox name is ScrubbedList. Table is named Scrubbed.
DCOUNT
Dim strScrubbedValue As String
strScrubbedValue = Me.ScrubbedList
Dim intCountNull As Integer
intCountNull = DCount("*", "Scrubbed", "IsNull" & strScrubbedValue)
Text267 = intCountNull
SQL
Dim strSQL As String
Dim strScrubbedValue As String
strScrubbedValue = Me.ScrubbedList
strSQL = "SELECT Count(*) As CountAll" & strScrubbedValue & " FROM Scrubbed"
strSQL = strSQL + "WHERE" & strScrubbedValue = ""
Me.List265.RowSource = strSQL
Try:
intCountNull = DCount("*", "Scrubbed", "SomeField Is Null")
So for the combo:
intCountNull = DCount("*", "Scrubbed", strScrubbedValue & " Is Null")
It is important to ensure that you have included relevant spaces when concatenating strings.
Dim strSQL As String
Dim strScrubbedValue As String
strScrubbedValue = Me.ScrubbedList
strSQL = "SELECT Count(*) As CountAll " & strScrubbedValue & " FROM Scrubbed"
strSQL = strSQL & " WHERE " & strScrubbedValue & " Is Null"
Me.List265.RowSource = strSQL
Note that Null and zero-length strings (ZLS) are not the same.
To get both, you can say:
strSQL = strSQL & " WHERE " & strScrubbedValue & " & '' = ''"
The string concatenator in VBA is &, not +. The plus sign must be used with care, because it can lead to unexpected nulls.
Related
Here is my table structure:
ID1 - autonumber
TDate - Date/Time
TTime - Date/Time
TID - Text
TMessage - Text
Tcode - text
TMessage value can be 100+ characters. There can be more than 1 TMessage for each TID
Sample input:
TDate TID TTime TMessage
1/9/2014 93378 12:28:28 PM aaaaaaaaaaaa
7/24/2014 02645 12:56:22 PM bbbbbbbbbbbb
7/24/2014 02645 12:56:30 PM cccccccccccc
Output should be:
TDate, TID, TMessage
1/9/2014 93378 aaaaaaaaaa
7/24/2014 02645 bbbbbbbbbb,cccccccccccc (the output can be more than 255 chars.)
This is my query/module (got from Stackoverflow and Allen Brown)
Query (SQL View)
SELECT sub.TDate, sub.TID, ConcatRelated("[TMessage]","RawData2","[TDate] = '" & sub.TDate & "' AND [TID] = '" & sub.TID & "'","[TDate], [TID]") AS concat_Message
FROM (SELECT q.TDate, q.TID FROM RawData2 AS q GROUP BY q.TDate, q.TID) AS sub
ORDER BY sub.TDate, sub.TID;
Function :
Option Compare Database
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere1 As Date, _
Optional strWhere2 As String, _
Optional strOrderBy1 As Date, _
Optional strOrderBy2 As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSql As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null
ConcatRelated = Null
'Build SQL string, and get the records.
strSql = "SELECT " & strField & " FROM " & strTable
If strWhere1 <> vbNullString And strWhere2 <> vbNullString Then
strSql = strSql & " WHERE " & strWhere1 And strWhere2
End If
If strOrderBy1 <> vbNullString And strOrderBy2 <> vbNullString Then
strSql = strSql & " ORDER BY " & strOrderBy1 And strOrderBy2
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
Currently, this is the output:
TDate TID Concat_Message
1/9/2014 93378 #Error
7/24/2014 02645 #Error
7/24/2014 04533 #Error
Question 1 - What could be the reason for the Error? How to solve it?
Question 2 - Can I just create a table manually with Memo field so I can store the result of the Query to this table?
I have been working with a database and received help getting the correct function to occur in that the code is working with a query and then looping through each report group (by name) and populating the fields of a report and saving the report by individual name. The last part of this which I have been struggling with. One of the fields in the recordset is Sup_Email, I’m trying to pass the report for sup with the email address in the above field to my default email client. I can’t figure how to isolate the second variable, keep it together with the right report and pass them both to email. Any help would be greatly appreciated.
Private Sub CreateReports_Click()
Dim x As String
Dim y As String
Dim z As String
Dim StrSQL
Dim StrEmail
Dim stWhereStr As String 'Where Condition'
Dim stSection As String 'Selection from drop down list
Dim stfile As String
StrSQL = "SELECT distinct[Sup] FROM ([OPDA ISSR- Courts Users by District/Cir])"
StrEmail = "SELECT [Sup_email] FROM ([OPDA ISSR- Courts Users by District/Cir])"
y = Year(date)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Dim qdTemp As DAO.QueryDef
Set qdTemp = db.CreateQueryDef("", StrSQL)
Set rst = qdTemp.OpenRecordset()
If rst.EOF And rst.BOF Then
MsgBox "No data available for the Ledger Process routine."
Else
rst.MoveFirst
Do While Not rst.EOF
x = rst![Sup]
z = rst![Sup_email]
stDocName = "Courts - ISSR Recertification Report"
stWhereStr = "[OPDA ISSR- Courts Users by District/Cir].[SUP]= '" & x & "'"
stfile = "P:\DFI\FIB\Access Tables\FibCustomers\ISSR Reports\Courts\" & x & " - " & y & " FedInvest InvestOne Recertification.pdf"
DoCmd.OpenReport stDocName, acPreview, , stWhereStr
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, stfile
DoCmd.Close acReport, stDocName
rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
End Sub
Each Sup has only one email address. The way it is setup is that a query (the OPDA ISSR- Courts Users by District/Cir query from above) pulls the first and last name of the supervisor and concatenates it into Sup, it also has their phone and email address (Sup_email), then has the employee, their accounts and access level, this information all applies to each field of the form. The direction I was sent yesterday created a query recordset (it's was continuing to loop). I tried then to add the field for email, and it's all gone awry since.
I have modified your code so that it uses the email address from the table and will create the report, then send.
Private Sub CreateReports_Click()
Dim x As String
Dim y As String
Dim StrSQL As String
Dim stWhereStr As String 'Where Condition'
Dim stSection As String 'Selection from drop down list
Dim stfile As String
Dim stDocName As String
Dim StrEmail As String
StrSQL = "SELECT DISTINCTROW [OPDA ISSR- Courts Users by District/Cir].[Sup], [OPDA ISSR- Courts Users by District/Cir].SupEmail " & _
"FROM [OPDA ISSR- Courts Users by District/Cir];"
y = Year(Date)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Dim qdTemp As DAO.QueryDef
Set qdTemp = db.CreateQueryDef("", StrSQL)
Set rst = qdTemp.OpenRecordset()
If rst.EOF And rst.BOF Then
MsgBox "No data available for the Ledger Process routine."
Else
Debug.Print rst.Fields.Count
rst.MoveFirst
Do While Not rst.EOF
x = rst![Sup]
StrEmail = rst![Supemail]
stDocName = "Courts - ISSR Recertification Report"
stWhereStr = "[OPDA ISSR- Courts Users by District/Cir].[SUP]= '" & x & "'"
stfile = "P:\DFI\FIB\Access Tables\FibCustomers\ISSR Reports\Courts\" & x & " - " & y & " FedInvest InvestOne Recertification.pdf"
DoCmd.OpenReport stDocName, acPreview, , stWhereStr
DoCmd.SendObject acSendReport, stDocName, acFormatPDF, StrEmail, , , "My Subject here", "your report"
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, stfile
DoCmd.Close acReport, stDocName
rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
End Sub
I have a query in which I select multiple columns, but only need the results to return a distinct set of data:
Dim strSQL As String
strSQL = "SELECT REQUIRED_TOOLS.REQUIRED_TOOL_NSN, REQUIRED_TOOLS.REQUIRED_TOOL_NAME, REQUIRED_TOOLS.ID, OEM_MASTER.OEM_No, REQUIRED_TOOLS.IS_TEST_EQUIP, OEM_MASTER.OEM_IN_INVENTORY, AIRCRAFT_EQUIPMENT.ID"
strSQL = strSQL & " FROM (OEM_MASTER INNER JOIN (REQUIRED_TOOLS INNER JOIN REL_OEM_TO_NSN ON REQUIRED_TOOLS.ID = REL_OEM_TO_NSN.NSN_REF_ID) ON OEM_MASTER.ID = REL_OEM_TO_NSN.OEM_REF_ID) INNER JOIN (AIRCRAFT_EQUIPMENT INNER JOIN REL_AC_EQUIP_TO_TOOLS ON AIRCRAFT_EQUIPMENT.ID = REL_AC_EQUIP_TO_TOOLS.AC_EQUIP_ID) ON REQUIRED_TOOLS.ID = REL_AC_EQUIP_TO_TOOLS.TOOL_ID"
strSQL = strSQL & " WHERE (((REQUIRED_TOOLS.IS_TEST_EQUIP)=No) AND ((OEM_MASTER.OEM_IN_INVENTORY)=Yes) AND ((AIRCRAFT_EQUIPMENT.ID)=" & Me.List0.Column(2) & "))"
strSQL = strSQL & " GROUP BY REQUIRED_TOOLS.REQUIRED_TOOL_NAME"
Me.List1.RowSource = strSQ
When I comment out the group by clause, I get results, but multiple results of REQUIRED_TOOL_NAME (which only exist in its own table once, but can have multiple OEM_MASTER.OEM_No references in the OEM_MASTER.OEM_No table/column). I need to filter out all repeat instances in my list.
Thanks.
I'm running a "select distinct" query on fields selected in a multiselect listbox (the listbox is populated with fields from a table). The code worked fine before I made it multiselect, and now the SQL query is not functioning. For example when I select the fields "Gender" and "INTERFACE" from the field list, the results in the 2nd list box are:
SELECT DISTINCT
Gender
INTERFACE
Ideally my results would include the field name and then the values, with a line between each field results.
Here is my code:
Dim strSQL As String
Dim strCriteria As String
Dim varItem As Variant
On Error GoTo Err_Command206_Click
For Each varItem In Me.ScrubbedList.ItemsSelected
strCriteria = strCriteria & ",[" & Me!ScrubbedList.ItemData(varItem) & "]"
Next varItem
strSQL = "SELECT DISTINCT " & Mid(strCriteria, 2) & " FROM Scrubbed"
'====== Testing
Debug.Print strSQL
'=====
Me.List316.RowSource = strSQL
Exit_Command206_Click:
Exit Sub
Err_Command206_Click:
MsgBox "Please select a field"
You seem to have some things in the wrong place:
Dim strSQL As String
Dim strCriteria As String
Dim varItem As Variant
On Error GoTo Err_Command206_Click
For Each varItem In Me.ScrubbedList.ItemsSelected
strCriteria = strCriteria & ",[" & Me!ScrubbedList.ItemData(varItem) & "]"
Next varItem
strSQL = "SELECT DISTINCT " & Mid(strCriteria,2) & " FROM Scrubbed"
'====== Testing
Debug.Print strSQL
'======
Me.List316.RowSource = strSQL
Exit_Command206_Click:
Exit Sub
Err_Command206_Click:
MsgBox "Please select a field"
I have a multi-select listbox which I want to be the source of a sql query with results displayed in a listbox. Currently I have the results going to a recordset which is displayed beautifully when only one 1 field is selected. For instance, if the user selects Gender, no recordset datasheet opens and List20 shows the field name, underscored, with the distinct values below it--Perfect!! When I try to select more than one item things go awry. For instance 2 items selected (Gender, Interface) will result in Gender (underlined) but with 2 F's and 2 M's below it and none of the Interface field values. How do I loop through each selection and have them show in the listbox? Here is my code. Also, weirdly, List13 shows no results when I run the query, but when I take away the line:
Set Me.List13.Recordset = rs
a recordset datasheet opens up and the desired results no longer appear in List20. Please help!
Private Sub Command19_Click()
Dim strSQL As String
Dim strCriteria As String
Dim varItem As Variant
Dim dbs As Database
Set dbs = CurrentDb()
Dim qdf As QueryDef
Dim rs As Recordset
On Error GoTo Err_Command19_Click
For Each varItem In Me!List101.ItemsSelected
strCriteria = strCriteria & ",'" & Me!List101.ItemData(varItem) & "'"
Next varItem
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT DISTINCT " & strCriteria & " FROM Scrubbed"
strSQL = Replace(strSQL, "'", "")
Set rs = dbs.OpenRecordset(strSQL)
Do Until rs.EOF
Set Me.List20.Recordset = rs
Set Me.List13.Recordset = rs
Loop
With dbs
Set qdf = .CreateQueryDef("TmpDistinctValues", strSQL)
DoCmd.OpenQuery "TmpDistinctValues"
.QueryDefs.Delete "TmpDistinctValues"
End With
dbs.Close
qdf.Close
Exit_Command19_Click:
Exit Sub
Err_Command19_Click:
MsgBox "Please select a field"
End Sub
Surely you mean:
For Each varItem In Me!List101.ItemsSelected
strCriteria = strCriteria & "," & Me!List101.ItemData(varItem)
colcount = colcount + 1
colwidths = colwidths & ";" & "1134"
Next varItem
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT DISTINCT " & strCriteria & " FROM Scrubbed"
''strSQL = Replace(strSQL, "'", "")
''Set rs = dbs.OpenRecordset(strSQL)
''Do Until rs.EOF
Me.List20.RowSource = strSQL
Me.List20.ColumnCount = colcount
Me.List20.ColumnWidths = Mid(colwidths, 2)
''Set Me.List13.Recordset = rs
''Loop