I still haven't been able to do this without running into errors.
For a project that I am doing, I am using Microsoft access to create a database that will be used to filter out data for a report from ONE table based on information that is entered in from Multiple multi-select listboxes, Multiple Textboxes and One Combo Box.
I know how to do for one Multi-Select listbox, but I am having issues adding in my other multi-select listboxes that I have. Is it possible to do it all from just one source or am I going to have to use multiple tables?
If I am able to do it from one table (as the source), how would I go about doing that and also adding in the textboxes and combobox? I can provide my code if necessary of what I currently have.
https://access-programmers.co.uk/forums/showthread.php?t=286294&page=2
Code:
Private Sub Command62_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryMultiselect")
For Each varItem In Me!District.ItemsSelected
strCriteria = strCriteria & ",'" & Me!District.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything in the Contract field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
For Each varItem In Me!MOPointofEntry.ItemsSelected
strCriteria1 = strCriteria1 & ",'" & Me!MOPointofEntry.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria1) = 0 Then
MsgBox "You did not select anything in the Name field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria1 = Right(strCriteria1, Len(strCriteria1) - 1)
For Each varItem In Me!MOMethodofEntry.ItemsSelected
strCriteria2 = strCriteria2 & ",'" & Me!MOMethodofEntry.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria2) = 0 Then
MsgBox "You did not select anything in the Type field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria2 = Right(strCriteria2, Len(strCriteria2) - 1)
strSQL = "SELECT * from TblDataEntry" & _
"WHERE TblDataEntry.District IN(" & strCriteria & ") AND TblDataEntry.MOPointofEntry IN(" & strCriteria1 & ") AND TblDataEntry.MOMethodofEntry IN(" & strCriteria2 & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryMultiselect"
multi select list box do not lend themselves to being the source of a query criteria. this is a topic you can look up and see other Q/A out there as to the reason and complexity of attempting to use them.
changing to multiple single list box, if that is possible, is recommended.
another approach is to add a checkbox field to the table of the multi list records. then set up a sub form using the checkbox as the method to flag multiple records.
Related
I am trying to use the following VBA code to run a select query in MS Access.
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
strSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenDynaset)
End Sub
I have added this to a button in MSACCES to pull this information from a linked SQL database. I have also been having issues with adding references to form text boxes but I may submit that as a separate question. Whenever I press the button, nothing happens. I don't even get an error screen. I have seen other answers where the issue seems to be how the OpenRecordSet is being used but I am having trouble understanding how I can apply it to this code.
The query itself does work when I create a separate query in Access so I am not sure where the problem is. I reformatted the SQL portion of the code to make it easier to read here, but I have it formatted as a single line in the actual VBA code.
It looks like you want to open a query in Access for display based on a SQL string
The following function will create a query based on the SQL string
Function createQry(qryName As String, sSQL As String)
Dim qdf As QueryDef
' Delete existing query
On Error Resume Next
CurrentDb.QueryDefs.Delete (qryName)
On Error GoTo 0
Set qdf = CurrentDb.CreateQueryDef(qryName, sSQL)
End Function
If you use this code in your posted code like that
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
StrSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
'Set rsSQL = dbs.OpenRecordset(StrSQL, dbOpenDynaset)
Dim qryName As String
qryName = "qryTest"
' close the query in case it is open in Access
DoCmd.SetWarnings False
DoCmd.Close acQuery, qryName
DoCmd.SetWarnings True
' Create the query based on the SQL string
createQry qryName, StrSQL
' Open the query in Access for display
DoCmd.OpenQuery qryName, acNormal, acReadOnly
End Sub
I use ConcatRelated function (made by Allen Browne) to merge string values from several rows in the MainTable, grouped by CategoryNumber:
ConcatRelated("[TextField]", "[MainTable]", "[CategoryNumber] = " & [CategoryNumber])
In that scenario, function works perfectly. However, I need to merge rows with only some of the categories. I store these selected categories in the Table2. I made Query1 that connects Table2 with MainTable through Tag field.
SELECT MainTable.CategoryNumber, MainTable.TextField
FROM Table2 INNER JOIN MainTable ON Table2.Tag = MainTable.ConnectedTag;
Now I have only selected rows I want to use with Concat function. I try to use it in the same way as previous:
ConcatRelated("[TextField]", "[Query1]", "[CategoryNumber] = " & [CategoryNumber])
Then occurs Error 3061: too few parameters. Expected 1.
I also try to use Concat as the event procedure in the form.
In result i see Run-time error '2465' can't find the field '|1'
ConcatRelated module looks like this and, as mentioned before, it works just fine in many other cases:
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
Dim rs As DAO.Recordset
Dim rsMV As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Dim bIsMultiValue As Boolean
ConcatRelated = Null
strSQL = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSQL = strSQL & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSQL = strSQL & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
bIsMultiValue = (rs(0).Type > 100)
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
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
I use Access 2013 with SQL server. What I do wrong?
I have figured this out. ConcatRelated doesn't want to read my query, so I decided to feed function with temporary table, where I will put data from that query. Here is the example workaround:
Build temporary table:
Create table with the same structure as your query.
Change your query type to Append Query (don't use Concat function yet - you will build another query for that).
Set where each column of your Append Query should send data to your temporary table.
Make sure your temporary table has accurate data:
If you use ConcatRelated in specific form, add VBA to this form's opening event to delete all records from temporary table (something like this:
DoCmd.RunSQL ("DELETE * FROM TempTable;")
Now your temp table is clear, so you may execute your Append Query (in the same form’s event procedure), to fulfill temp table with proper data:
DoCmd.OpenQuery "YourAppendQuery"
Run another query (the one with ConcatRealted function), but this time refer to your temp table. In above case, it would look like that:
ConcatRelated("[TextField]", "[TempTable]", "[CategoryNumber] = " & [CategoryNumber])
Maybe it's not a beautiful solution, but it works for me and allows me to go further with my project.
I have some problem when I deal with MS Access. I am using SQL Server and MS Access together.
I try to insert data into a new table.
First, this program asks me to add an item to the list (it is like temporary table). And then, there is another submit button which confirms the data (this step is needed and it is not inefficient one. Please do not ask about this step).
To add data to the list, I use a stored procedure. But I do not know what do I need to do to submit the data again.
Here is my code:
Dim rs As ADODB.Recordset
strConn = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;"
Set conn = New ADODB.Connection
conn.Open strConn
cmd.ActiveConnection = conn
Set rs = New ADODB.Recordset
rs.Open "Insert into dbo.Blend values(List731.Column(1, introw),List731.Column(2, introw),TextRequestNo.Value, List731.Column(3, introw),List731.Column(4, introw),List731.Column(5, introw))"
conn.Close
Set rs = Nothing
MsgBox "Done"
When I run with this code, I get this error:
I think there is some missing in my code but I do not know how to proceed.
Is there anyone who can give me some information about this?
There are many ways to do this kind of thing. Something like this should get the job done.
Sub MoveDateFromAccessToSQLServer()
Dim adoCN As ADODB.Connection
Dim sConnString As String
Dim sSQL As String
Dim lRow As Long, lCol As Long
sConnString = "Provider=sqloledb;Server=servername;Database=NORTHWIND;User Id=xx;Password=password"
Set adoCN = CreateObject("ADODB.Connection")
'adoCN.Open sConnString
'Assumes that you have Field1, Field2 and Field3 in columns A, B and C
'Text values must be enclosed in apostrophes whereas numeric values should not.
sSQL = "INSERT INTO YOUR_TABLE (FIELD1, FIELD2, FIELD3) " & _
" VALUES (" & _
"'" & Column(1, introw) & "', " & _
"'" & Column(2, introw) & "', " & _
"'" & Column(3, introw) & "')"
adoCN.Execute sSQL
adoCN.Close
Set adoCN = Nothing
End Sub
I am currently working within MS Access 2016. One of the requirements for the project that I am working on is tying the users Windows login to MS Access. I am only grabbing the users "User Name". Within Access there will be permissions set to users within a table. Once the users login based upon there permissions they will be directed to their specific opening page. I was able to successfully retrieve the users windows login but I am having trouble connecting to my back end table.
My Table name is tblUser the field names are:
FName LName postion UserName(PK) EmployeeType_ID
The code that I have is below I am getting a Run-time error '3077' "Syntax error in string in expression" at "rs.FindFirst "UserName='". I am not sure what the problem is any help would be greatly appreciated.
Private Sub Form_Load()
Debug.Print Environ("UserName")
Debug.Print Environ$("ComputerName")
Dim strVar As String
Dim i As Long
For i = 1 To 255
strVar = Environ$(i)
If LenB(strVar) = 0& Then Exit For
Debug.Print strVar
Next
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblUser", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='"
If rs.NoMatch = True Then
MsgBox "You do not have access to this database.", vbInformation, "Access"
Exit Sub
End If
If rs!EmployeeType_ID = 4 Then
Dim prop As Property
On Error GoTo SetProperty
Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False)
CurrentDb.Properties.Append prop
SetProperty:
If MsgBox("Would you like to turn on the bypass key?", vbYesNo, "Allow Bypass") = vbYes Then
CurrentDb.Properties("AllowBypassKey") = True
Else
CurrentDb.Properties("AllowBypassKey") = False
End If
End If
DoCmd.OpenForm "frmManager"
DoCmd.Close acForm
If rs!EmployeeType_ID = 3 Then
DoCmd.OpenForm "frmGeneral_User"
DoCmd.Close acForm
End If
If rs!EmployeeType_ID = 2 Then
DoCmd.OpenForm "frmAdmin"
DoCmd.Close acForm
End If
If rs!EmployeeType_ID = 1 Then
DoCmd.OpenForm "frmGuest"
DoCmd.Close acForm
End If
End Sub
p.s. I fully understand that someone can bypass the security controls set within Access. This is specifically for functionality.
Please find below part of what I use when grabbing data from a backend:
You can modify the below to pull that specific individuals access rights, you can then set the correct userform to be displayed based on the data pulled from the back end.
Dim acc As Access.Application
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strPassword As String
Dim DBpath As String
Dim DBname As String
Dim tblStructure As String
DBpath = "C:\Projects
DBname = "Self Serve Database.accdb"
tblStructure = "_tbl_Structure"
strPassword = "OpenSesame"
strSQL = "INSERT INTO _tbl_Structure " & _
"SELECT * " & _
"FROM [MS Access;pwd=" & strPassword & ";database=" & DBpath & "\" & DBname & "].[" & tblStructure & "] " & _
"WHERE [USER ID] = '" & Environ("username") & "'"
I am trying to pull a list of names and email addresses from a tables in access and use that information to send out personalized emails. So I am trying to call 2 columns from access into an array and then using a loop to go through each row. I think this will be the best way to do it but i am open to other ideas. I have been able to generate code that produces one email with the first record, but i have no idea how to go about getting the rest of the records:
Private Sub SMT()
Application.Run "VariablesForRanges"
strDB1 = ThisWorkbook.Path & "\database.accdb"
strqry1 = "SELECT table1.name, table2.Email"
strqry1 = strqry1 & " FROM table2 inner join table1 on table1.FULL_NAME=table2.Name"
strqry1 = strqry1 & " group by table1.name, table2.Email;"
Set cn1 = New ADODB.Connection
cn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB1 & ";"
Set rs1 = New ADODB.Recordset
With rs1
Set .ActiveConnection = cn1
.Open strqry1
End With
If rs1.BOF = True Then
MsgBox "There Are No Records To Import", vbInformation
Else
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi " & rs1("name") & "," & vbNewLine & vbNewLine & _
"test" & vbNewLine & vbNewLine & _
"Best regards," & vbNewLine & _
On Error Resume Next
With OutMail
.To = rs1("Email")
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
End Sub
Any help with creating an array and loop would be appreciated. Thanks.
Why not just loop through the record set?
Do While Not rs1.EOF
' create emails
rs1.MoveNext
Loop