I am running an expression to loop through a recordset and with a string from each record run an update query on second table. Based on a LIKE match it updates a field to create a relation. I am having problem with Runtime Error '424' Object Required at CurrentDb.Execute.
Tables:
Transactions (main table to update)
TransactionType (relation table of types or categories)
TransSet (List of strings and transactiontype to set to)
Private Sub Toggle1_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb Set rst = db.OpenRecordset("TransSet")
Do Until rst.EOF
CurrentDb.Execute ("UPDATE Transactions SET Transactions.TransactionType =" & (TransSet.TransTypeSet) & " WHERE ((Transactions.TransactionText1) Like * " & (TransSet.TransIdent) & "*))")
rst.MoveNext Loop
rst.Close Set rst = Nothing
End Sub
Reference the recordset object, not the table or query the recordset is based on.
Need apostrophe delimiters for text type fields paramaters.
CurrentDb.Execute ("UPDATE Transactions SET TransactionType ='" & rst!TransTypeSet & "'" & _
" WHERE TransactionText1 Like '*" & rst!TransIdent & "*'")
Thank you - I also had realised my error and fixed the code. I also changed the table name to not confuse with reserved words.
Private Sub Toggle1_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * FROM TransSet")
Do Until rst.EOF
CurrentDb.Execute ("UPDATE Trans SET trans.TransactionType =" & (rst!TransTypeSet) & " WHERE ((Trans.TransactionText1) Like '*" & (rst!TransIdent) & "*');")
' MsgBox ("UPDATE Trans SET trans.TransactionType =" & (rst!TransTypeSet) & " WHERE ((Trans.TransactionText1) Like '*" & (rst!TransIdent) & "*');")
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub
Related
On my workstation, I've been using Access in English. Some other computer that will use my form have it in French. Testing it recently, I found out that Boolean variable, even if declared as True/False, come out as Vrai/Faux.
Where it becomes a problem is when I need to use the variable in a text, like an insert or simply a request.
The only workaround I have right now is using another variable of type String and replace it from French to English. The problem with this is... it's two ugly line. I mean, there must be another way than having to that every time i might use a Boolean variable in a request?
EDIT: Here is two exemples.
SELECT [...] FROM [...] WHERE [...] in (false , " & SomeBooleanValue & ");
-- OR --
str_Sql = "INSERT INTO [...] VALUES ('" & form_Name & "', " & is_something & ")"
DoCmd.RunSQL str_Sql
You could use parameters with your two examples and then not worry about concatenating into your SQL string:
Sub Test_1()
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Set qdf = CurrentDb.CreateQueryDef("", _
"PARAMETERS SomeBooleanValue BIT; " & _
"SELECT * FROM Table1 WHERE Field_2 = SomeBooleanValue")
With qdf
.Parameters("SomeBooleanValue") = True
Set rst = .OpenRecordset
End With
With rst
If Not (.BOF And .EOF) Then
.MoveFirst
Do
Debug.Print .Fields("Field_1") & " - " & .Fields("Field_2")
.MoveNext
Loop While Not .EOF
End If
End With
End Sub
and
Sub Test_2()
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.CreateQueryDef("", _
"PARAMETERS some_text TEXT(255), is_something BIT; " & _
"INSERT INTO Table1 VALUES (some_text, is_something)")
With qdf
.Parameters("some_text") = "Some random text"
.Parameters("is_something") = True
.Execute
End With
End Sub
You can use this format expression to force a True/False output string:
UKTrueFalse = Format(YourBooleanValue, "True;True;Fal\se")
As for your SQL, you could just use the numeric value:
SELECT [...] FROM [...] WHERE [...] IN (0 , " & Str(Abs(SomeBooleanValue)) & ");
Good morning,
I am helping to develop an interface via a Form in MS Access. We have a list box with various user values and the user should be able to select multiple values in the ListBox and then press the button to execute a query, returning only the rows whose Car Name is what was selected.
UPDATE - thanks to some great feedback on this forum, the primary issue was resolved. My secondary issue is now not being able to execute the query. When I try, I get the error that the query cannot be executed.
My code (as event procedure) for the button is:
Option Explicit
Private Sub btnSearchCars_Click()
MsgBox "Starting Sub"
Call QueryCars.myQuery
MsgBox "Ending Sub"
End Sub
Then, my QueryCars module looks like this:
Sub myQuery()
Dim strWhere As String
Dim strSQL As String
Dim varItem As Variant
For Each varItem in Forms!FormSelect!listCarID.SelectedItems
strWhere = strWhere & "'" & Forms!FormSelect!listCarID.ItemData(varItem) & "',"
Next
strWhere = Left(strWhere, Len(strWhere) -1)
strSQL = "SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & strWhere & ");"
DoCmd.RunSQL strSQL
End Sub
My error is an "A RunSQL requires an argument of an SQL statement" error on the line.
DoCmd.RunSQL strSQL
I would really appreciate it if someone could help. All I am trying to do is take the values from the list box the user selects and use them as WHERE criteria in my query. I have searched various SO and Access forums all morning and have not found anything to help.
Thank you. Please let me know if you have any questions.
This isn't the perfect answer I was hoping to give you - but can't figure out how to use parameter queries in an IN command.
I'll assume that your listbox contains two columns of data and the CarID values are in the first column.
The main function is called ProcessQuery and accepts a reference to the listbox as an argument:
Public Sub ProcessQuery(myList As ListBox)
You can then call your code from the event on the listbox and pass it the listbox reference.
Private Sub btnSearchCars_Click()
ProcessQuery Me.listCarID
End Sub
The ProcessQuery procedure then looks at the first column to get the index numbers, constructs the SQL, opens the resulting recordset and pulls the info from each record.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
Set rst = qdf.OpenRecordset
'Move through the recordset and output the first two fields from each record
'to the Immediate window.
With rst
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
Debug.Print .Fields(0) & " - " & .Fields(1)
.MoveNext
Loop
End If
End With
End Sub
To display the query result as a datasheet you could use the following, but I'd prefer to use a stored query with a parameter for the IN. I'll try and figure that bit out.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("TempQDF", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
DoCmd.OpenQuery "TempQDF", acViewNormal
End Sub
I would suggest first taking a look at the actual WHERE clause being generated...keep a separate string variable to store it, and then dump it to the Immediate Window when it's generated.
I would also suggest creating a separate function to return values selected in a list box as an array. Something like:
Public Function getListBoxSelection(ctl As Access.ListBox) As Variant
Dim arr() As Variant
Dim varItem As Variant, i As Long
If ctl.ItemsSelected.Count > 0 Then
ReDim arr(0 To ctl.ItemsSelected.Count - 1)
i = 0
For Each varItem In ctl.ItemsSelected
arr(i) = ctl.ItemData(varItem)
i = i + 1
Next varItem
End If
getListBoxSelection = arr
End Function
Then, you would call it in SQL generation. Something like
whereClause = join(getListBoxSelection(me.listCarID), " AND ")
debug.Print whereClause
qdf.SQL = _
"select tblBig.* " & _
"from tblCars " & _
"inner join tblBig on tblCars.Cat_ID = tblBig.Car_ID " & _
"where tblCars.Card_ID in (" & whereClause & ")"
Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function
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
How can you increase the size of a MDB field size using DAO?
You can do this much more easily with DDL:
Set db = CurrentDb
sSQL = "ALTER TABLE table1 ALTER Column atext text(150)"
db.Execute sSQL, dbFailOnError
Apparently, this is not available in MS Access 97, but in any version in the 15 year since, I would suggest that DDL is the simplest approach.
From http://www.freevbcode.com/ShowCode.asp?ID=4599:
Public Sub change_field_size(DBPath as string, _
tblName As String, fldName As String, fldSize As Integer)
' this routine changes the field size
Dim db As Database
Dim td As TableDef
Dim fld As field
On Error GoTo errhandler
Set db = OpenDatabase(DBPath)
Set td = db.TableDefs(tblName)
If td.Fields(fldName).Type <> dbText Then
' wrong field type
db.Close
Exit Sub
End If
If td.Fields(fldName).size = fldSize Then
' the field width is correct
db.Close
Exit Sub
End If
' create a temp feild
td.Fields.Append td.CreateField("temp", dbText, fldSize)
td.Fields("temp").AllowZeroLength = True
td.Fields("temp").DefaultValue = """"""
' copy the info into the temp field
db.Execute "Update " & tblName & " set temp = " & fldName & " "
' delete the field
td.Fields.Delete fldName
' rename the field
td.Fields("temp").Name = fldName
db.Close
'======================================================================
Exit Sub
errhandler:
MsgBox CStr(Err.Number) & vbCrLf & Err.Description & vbCrLf & "Change Field Size Routine", vbCritical, App.Title
End Sub