Database Structure:
UserName String
Location String
Price Number
Requirement:
I have listbox with some items into it say 100. The user will select only 10 randomly in the listbox (after changing the MULTISELECT to 2fmMultiselect property). I will have search button. Once I select and click Search, the total price of selected items has to be calculated and displayed.
My search code ( Thanks to Alex sir)
enter code here
Private Sub CommandButton4_Click()
Dim Cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sName As String
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=d:\test2.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open
Set rs = New ADODB.Recordset
sName = Replace$(TextBox1.Text, "'", "''")
rs.Open "Select * from SampleTable where UserName = '" & sName & "'", Cn, adOpenForwardOnly, adLockReadOnly, adCmdText
If (rs.EOF) Then
MsgBox "no match"
Else
TextBox3.Text = rs("UserName") & " " & rs("Location")
rs.Close
End If
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
That code was just to search and display in a textbox.
Now, I need to total the price of what all UserName field selected by the user from listbox.
Try this, but make sure the bound column in your list box is the ID field of your table.
Private Function SelectedListString(lstSelected As Access.ListBox) As String
'Loop though a list and get the IDs of all the selected items
'Assumes the bound column is the contains the ID field
Dim sList As String
Dim vSelected As Variant
With lstSelected
For Each vSelected In .ItemsSelected
sList = sList & .ItemData(vSelected) & ","
Next
End With
If sList <> "" Then sList = Left(sList, Len(sList) - 1) 'trim trailing coma
SelectedListString = sList
End Function
you can use the result in an IN statement in your SQL
Dim sSql As String
If myListbox.ItemsSelected.Count > 0 Then
sSql = "SELECT * FROM table WHERE IDField IN (" & SelectedListString(myListbox) & ")"
End If
Related
I am trying to open form X through form Y, where docid = docid
form X's table has a primary key column named "abcid" (the matching id)
I am trying to pass the label name of form Y's textbox's label "abcid" as string "abcid", the idea is to pass the column name dynamically whatever the used form is ==> in VBA OpenForm WHERE condition, but it doesn't execute properly or opens a blank form. code below:
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim checklistformName As String
Dim viewdocformName As String
Dim currentformName As String
currentformName = Screen.ActiveForm.Name
'Debug.Print currentformName
Dim docidcolumnName As String
docidcolumnName = Forms(currentformName).Controls(docid).Caption
Debug.Print docidcolumnName
Set rs1 = CurrentDb.OpenRecordset("SELECT DISTINCT checklistformname FROM CyclesDefinitions WHERE cycledefid = " & Forms(currentformName)![cycledefid])
Do Until rs1.EOF = True
checklistformName = rs1(0)
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set rs2 = CurrentDb.OpenRecordset("SELECT DISTINCT viewdocformname FROM CyclesDefinitions WHERE cycledefid = " & Forms(currentformName)![cycledefid])
Do Until rs2.EOF = True
viewdocformName = rs2(0)
rs2.MoveNext
Loop
rs2.Close
Set rs2 = Nothing
Debug.Print currentformName & " - " & checklistformName & " - " & viewdocformName
DoCmd.OpenForm viewdocformName, , , " & docidcolumnname & " = " & Forms(checklistformName)![docid], acFormReadOnly
alright, I solved the OpenForm with string dilemma with the following solution after testing a statically predefined string:
DoCmd.OpenForm viewdocformName, , , "" & docidcolumnName & " = " & Forms(checklistformName)![docid], acFormReadOnly
it just needed the proper concatenation, and instead of messing with the forms!frmname syntax, because I can't find the proper return value, I set the label name on form to pkcolname and recalled it in VBA like this:
docidcolumnName = Me.pkcolname.Caption:
now everything is working as expected and required.
I can't work out where I am going wrong with my code. When the user selects a value in the combo box, i want it to go to the Consultants table and grab the default rate for that consultant and stick it in the Hourly Rate text box. This is the msg that I get when I update the combobox.
Private Sub cmbConsultant_Change()
Dim db As Database
Dim rs As DAO.Recordset ''Requires reference to Microsoft DAO x.x Library
Dim strSQL As String
strSQL = "defaultFee * FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
Me.txtHourlyRate = rs!CountOfEndDeviceType
Else
Me.txtHourlyRate = ""
End If
Set rs = Nothing
Set db = Nothing
End Sub
You could use DLookup for this - much simpler:
Private Sub cmbConsultant_Change()
Me!txtHourlyRate.Value = DLookup("defaultFee", "tblConsultants", "ID = '" & Me!cmbConsultant.Value & "'")
End Sub
However, most likely your ID is numeric, thus:
Private Sub cmbConsultant_Change()
Me!txtHourlyRate.Value = DLookup("defaultFee", "tblConsultants", "ID = " & Me!cmbConsultant.Value & "")
End Sub
I Think You need some SELECT Here
strSQL = "defaultFee * FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
It Should Be:
strSQL = "SELECT defaultFee AS [CountOfEndDeviceType] FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
Also Note, That [CountOfEndDeviceType] Must be a FieldName, SO I've put it in a Select statement.
Let's say I have a single table called "Customers". It contains 2 fields:
Name
Address
I want users to be able to select multiple records by selecting their names. For example something like having a list box containing all the names of the records in the database. I want users to be able to select multiple items like:
Dave Richardson
Bob Smith
Sophie Parker
And then only display records with these names in the report.
You can use the WhereCondition option of the DoCmd.OpenReport Method to filter your report as needed.
Const cstrReport As String = "YourReportNameHere"
Dim custNames As String
Dim lItem As Variant
Dim strWhereCondition As String
With Me.yourListBoxName
For Each lItem In .ItemsSelected
custNames = custNames & ",'" & Replace(.ItemData(lItem), "'", "''") & "'"
Next
End With
If Len(custNames) > 0 Then
custNames = Mid(custNames, 2)
strWhereCondition = "[Name] IN (" & custNames & ")"
End If
DoCmd.OpenReport ReportName:=cstrReport, View:=acViewPreview, _
WhereCondition:=strWhereCondition
Note this approach has features in common with PaulFrancis' answer. In fact, I copied his code and modified it. The key difference is that this approach does not require you to revise a saved query in order to filter the report.
The setup I would I have is, a Form with a SubForm and a ListBox, the Listbox will have the names of all your customers. So the RowSource would be,
SELECT
customerNameFieldName
FROM
yourTableName;
The Multi Select property will be setup to Extended. Then a button will have the following code that will generate the SQL for the SubForm's recordsource.
Private Sub buttonName_Click()
Dim lItem As Varaint, strSQL As String
Dim custNames As String, whereStr As String
Dim dbObj As dao.Database
Dim tmpQryDef As QueryDef
Set dbObj = CurrentDb()
For Each lItem In Me.yourListBoxName.ItemsSelected
custNames = custNames & "'" & Me.yourListBoxName.ItemData(lItem) & "', "
Next
Id Len(custNames) <> 0 Then
custNames = Left(custNames, Len(custNames) - 2)
whereStr = "WHERE customerNameFieldName IN (" & custNames & ")"
End If
strSQL = "SELECT someFields FROM someTable " & whereStr
Set tmpQryDef = dbObj.QueryDefs("Summary 3 Q1")
tmpQryDef.SQL = strSQL
DoCmd.OpenReport "yourReportName", acViewNormal
Set dbObj = Nothing
Set tmpQryDef = Nothing
End Sub
So now the SubForm will have the RecordSource based on all the information you have selected in the ListBox.
first off I am brand new to iMacros and not great with VBA (I know not a great start)
So my end game is to use iMacros to go to a site fill in a form on the site with a name from a table in access enter the name and grab some resulting text from that site grab the text and put it in a table. I will have to do this for each record in the table. So far this is what I have:
Dim Rs As DAO.Recordset 'recordset for list of names from VcWAuditUsers
Dim db As DAO.Database
Dim SQL As String
Dim Sql2 As String
Dim STRErr As String
Dim sTableName As String
Dim serverName As String
Dim dbName As String
Dim strUserCnt As Integer
Dim UserName As Variant
Dim StrSql As String
Dim iim1, iret
Set iim1 = CreateObject("imacros")
iret = iim1.iimInit
iret = iim1.iimPlayCode("URL GOTO=https://www.sam.gov/portal/public/SAM/)
sTableName = "vCPpAuditUsers"
serverName = GetLinkedServer(sTableName)
dbName = GetLinkedDatabase(sTableName)
SQL = "Select Distinct FName, LName from " & sTableName
Set db = CurrentDb
Set Rs = db.OpenRecordset(SQL)
If (Not Rs.EOF And Not Rs.BOF) Then
Rs.MoveLast
Rs.MoveFirst
With Rs
Do While (Rs.EOF = False)
UserName = Trim(![FName]) & " " & Trim(![LName])
MsgBox ("New Name: " & UserName)
strUserCnt = Rs.recordCount
MsgBox ("Number of rows: " & strUserCnt)
'set iMacros variables
iret = iim1.iimSet("CONTENT", UserName)
iret = iim1.iimPlay("Y:\Data\FS01-M\Healthcare\SAM_iMacro\SAMiMacro.iim")
If iret < 0 Then
MsgBox iim1.iimGetLastError()
End If
StrSql = "Insert Into ExceptionResults Values('" & UserName & "','" & iim1.iimGetExtract(1) & Now & "')"
MsgBox ("Test SqlInsert: " & StrSql)
.MoveNext
Loop
End With
Rs.Close
db.Close
End If
I know that I am missing some key stuff but I have been unable to find a good example to base what I am doing on.
Any help is greatly appreciated!
Thanks.
What I came up with:
Option Compare Database
Option Explicit
Private Sub cmdGetExceptions_Click()
Dim YNMess As String
YNMess = MsgBox("Do you wish to truncate results table ExceptionResults?", vbYesNo, "TRUNCATE?")
If YNMess = vbYes Then
Call ClearExceptionTable
Call RunExceptionTable
End If
If YNMess = vbNo Then
Call RunExceptionTable
End If
End Sub
Private Sub RunExceptionTable()
Dim Rs As DAO.Recordset 'recordset for list of names from VcWAuditUsers
Dim db As DAO.Database
Dim SQL As String
Dim sTableName As String
Dim serverName As String
Dim dbName As String
Dim strUserCnt As Integer
Dim UserName As Variant
Dim StrSql As String
Dim ExceptStat As String
On Error GoTo ErrHandler
Dim iim1, iret
' Creates iMacros object and gives the starting webpage
Set iim1 = CreateObject("imacros")
iret = iim1.iimInit
iret = iim1.iimPlayCode("URL GOTO=https://www.sam.gov/)
'Sets the source table name
sTableName = "[SourceTable]"
'Sets the SQL string to grab the names of people to be inserted into website input section
SQL = "Select Distinct FName, LName from " & sTableName
'Starts the recordset for the source table and recordset
Set db = CurrentDb
Set Rs = db.OpenRecordset(SQL)
'resets the RS to start at the begining
If (Not Rs.EOF And Not Rs.BOF) Then
Rs.MoveLast
Rs.MoveFirst
'Grabs the total record count to use for end user messaging.
strUserCnt = Rs.recordCount
'MsgBox ("Number of rows: " & strUserCnt)
'Opens RS and starts while loop to open first record of the source table
With Rs
Do While (Rs.EOF = False)
'Creates new UserName by combining first and last name
UserName = Trim(![FName]) & " " & Trim(![LName])
'MsgBox ("New Name: " & UserName)
'set iMacros variables This subs the spot in the iMacros code where you manually entered information (there should be {{USERNAME}} in the iMacros where you want to enter data.
iret = iim1.iimSet("USERNAME", UserName)
'Plays the iMacro you recorded and altered earlier.
iret = iim1.iimPlay("Location of your iMacros goes here.iim")
'Checks for errors in the iMacros(anything in the negative is considered an error)
If iret < 0 Then
MsgBox iim1.iimGetLastError()
End If
'grabs the extracted data from recorded iMacro. the extracted data is stored in an (1) based array. Makes substitutions for the text that it extracts to convert to 1 or 0
If Left(iim1.iimGetExtract(1), 2) = "No" Then
ExceptStat = 0
Else
ExceptStat = 1
End If
'For each record in the source the extracted data is entered into the insert statement below along with the employee name and date. then warnings are suppressed and each is inserted into a local access table, Loop and move to the next.
StrSql = "Insert Into ExceptionResults Values('" & UserName & "'," & ExceptStat & ",'" & Now & "')"
DoCmd.SetWarnings False
DoCmd.RunSQL (StrSql)
DoCmd.SetWarnings True
.MoveNext
Loop
End With
MsgBox ("ExceptionResults table is complete and has " & strUserCnt & " Records")
'Clean up
Rs.Close
db.Close
End If
'Clean up
Set db = CurrentDb
Set Rs = db.OpenRecordset(SQL)
Set iim1 = Nothing
strUserCnt = 0
ErrHandler:
MsgBox "ERROR" & vbCrLf & Err.Description, vbCritical, "CmdGetExceptions"
End Sub
Private Sub ClearExceptionTable()
Dim StrSql2 As String
StrSql2 = "Delete from ExceptionResults"
DoCmd.SetWarnings False
DoCmd.RunSQL (StrSql2)
DoCmd.SetWarnings True
MsgBox ("All records from ExceptionResults have been truncated")
End Sub
I have two tables and I have a form linking to one of them. I want to check a value and if it is true, add the record the other table by using VBA.
Can anyone help me, please?
This is my code, but it does not work:
Dim rec1 As DAO.Recordset
Dim rec2 As DAO.Recordset
Set rec1 = CurrentDb.OpenRecordset("TotalTPAq")
Set rec2 = CurrentDb.OpenRecordset("Visi")
rec1.MoveFirst
Do Until rec1.EOF
If rec1!Date = PlanDate.Value Then ' planDate is a text box
rec2.AddNew
rec2![Planing Date History] = PlanDate.Value
rec2.Update
rec2.Close
End If
rec1.MoveNext
Loop
rec1.Close
Set rec2 = Nothing
Set rec1 = Nothing
DoCmd.Close
This should provide a start for you:
'Run query to fill table
Private Sub btnRnQry_Click()
'No value entered
If IsNull(Me.txtEntry) Or Me.txtEntry = "" Then
MsgBox ("Is null or empty")
Else
'Assign value to variable
Dim entry As String
entry = Me.txtEntry
Dim sql As String
sql = "INSERT INTO tableTwo ([First Name],Surname,[Phone Number] )" & _
"SELECT * " & _
"FROM tableOne " & _
"WHERE [First Name] = '" & entry & "';"
'Run the SQL
DoCmd.RunSQL sql
End If
End Sub