The beginning of the following code is supposed to get the BaseName of a file name in a textbox on a form and set it equal to a String "tblnewbid". The Debug.Print tblnew bid prints out the correct Table name exactly as it is supposed to. I verified the characters match exactly and there is an actual table that matches that name.
When I run the code I get error: Cannot find table or constraint. If I manually change tblnew to the actual table name, the code runs fine. Could it be that I need to Dim tblnewbid as something other than string?
Private Sub btnInsertRegions_Click()
DoCmd.Hourglass True ' turn on Hourglass
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim FSO As New FileSystemObject
Dim tblnewbid As String
Set db = CurrentDb
tblnewbid = FSO.GetBaseName(Me.txtFileName)
Debug.Print tblnewbid
db.Execute "ALTER TABLE tblnewbid ADD COLUMN O_StateRegion CHAR", dbFailOnError
db.Execute "ALTER TABLE tblnewbid ADD COLUMN D_StateRegion CHAR", dbFailOnError
Set rs = db.OpenRecordset("Select [OriginState] from [tblnewbid];")
rs.MoveFirst
strSQL = "UPDATE [tblnewbid] INNER JOIN [tblStates]"
strSQL = strSQL & " ON [tblStates].[StateAbbrev] = [tblnewbid].[OriginState]"
strSQL = strSQL & " SET [tblnewbid].[O_StateRegion]=[tblStates].[StateRegion]"
db.Execute (strSQL), dbFailOnError
rs.MoveFirst
strSQL = "UPDATE [tblnewbid] INNER JOIN [tblStates]"
strSQL = strSQL & " ON [tblStates].[StateAbbrev] = [tblnewbid].[DestinationState]"
strSQL = strSQL & " SET [tblnewbid].[D_StateRegion]=[tblStates].[StateRegion]"
db.Execute (strSQL), dbFailOnError
rs.Close
Set rs = Nothing
When you place a variable inside double quotes, it stops being a variable and becomes a literal string.
What you want to do instead is have the variable evaluated and then placed inside of the string. You can do this with concatenation:
ie:
db.Execute "ALTER TABLE " & tblnewbid & " ADD COLUMN O_StateRegion CHAR", dbFailOnError
Apply this concatenation to each line that needs to evaluate your variable.
Related
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
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
I'm trying to open a record set using a SQL string. I get run time error 3061 "Too Few Parameters." any help would be appreciated.
Dim stAppName As String
Dim stURL As String
Dim rst As Recordset
Dim dbs As Database
Dim stringToSearch As Integer
Dim strSQL As String
Set dbs = CurrentDb
stringToSearch = InputBox("What is your route #?", "Enter route #: ")
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route=stringToSearch"
Set rst = dbs.OpenRecordset(strSQL)
Please change the code line of strSQL as follows, as suggested by Fionnuala you need to use variable outside the quotes.
Assuming Route field is Text data type, we need to put single quote for strings, if its number no single quote, for dates put # instead of single quote
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route='" & stringToSearch & "'"
It's a little sample, maybe it can help you
Public Function fn_SQL_dbOpenRecordset(Optional vsql As String = "") As Recordset
Dim dbs As DAO.Database
Dim rs As Recordset
On Error GoTo END_CODE
'Set the database
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset(vsql, dbOpenForwardOnly) 'you can use: dbOpenDynamic; dbOpenSnapshot; dbOpenTable
Set fn_SQL_dbOpenRecordset = rs
Exit Function
END_CODE:
Set fn_SQL_dbOpenRecordset = Nothing
End Function
Public Sub Program_Test()
On Error GoTo ERROR_SUB
Dim rs As Recordset
Dim sName As String
sName = "Joe"
sName = "'" & sName & "'" 'WARNING: BE CAREFUL WITH SQL INJECTION !!! Google it
Set rs = fn_SQL_dbOpenRecordset("select * from table1 d where PersonName = " & sName)
Dim i As Long
i = 0
While Not rs.EOF
Debug.Print rs(0).Value & " - " & rs(1).Value
rs.MoveNext
Wend
ERROR_SUB:
On Error Resume Next
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
End Sub
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