I'm trying to run a SQL command in VBA to delete certain records from a table. When I run it I'm prompted for parameters. What is causing this? I have included the subroutine that includes the SQL.
Public Sub AddCon(newCont, svID)
Dim daDb As DAO.Database
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim selContract As String
Set daDb = CurrentDb
Set rst1 = daDb.OpenRecordset("tblContracts")
Set rst2 = daDb.OpenRecordset("tblContractList")
rst2.AddNew
rst2!Contract = newCont
rst2!ID = svID
rst2.Update
rst2.Close
Set rst2 = Nothing
DoCmd.Close
Dim strSQL As String
strSQL = "DELETE * FROM [tblContractList] " _
& "WHERE rst1.Contract <> newCont"
DoCmd.RunSQL strSQL
DoCmd.OpenForm "frmContracts"
End Sub
As you make query,
DELETE * FROM [tblContractList] WHERE rst1.Contract <> newCont;
Microsoft Access engine will ask for you two unknowns via prompt: rst1.Contract and newCont.
So you should replace them with known values:
Public Sub AddCon(newCont, svID)
Dim daDb As DAO.Database
'Dim rst1 As Recordset
Dim rst2 As Recordset
' Dim selContract As String
Set daDb = CurrentDb
'Set rst1 = daDb.OpenRecordset("tblContracts")
Set rst2 = daDb.OpenRecordset("tblContractList")
rst2.AddNew
rst2!Contract = newCont
rst2!ID = svID
rst2.Update
rst2.Close
Set rst2 = Nothing
'DoCmd.Close
Dim strSQL As String
'
' DELETE query must be run with care, as useful data may disappear!!!
'
strSQL = "DELETE * FROM tblContractList " _
& "WHERE (Contract " & " <> " & newCont & ")"
'
' or single quoting newCont if it is a string:
'
'strSQL = "DELETE * FROM tblContractList " _
' & "WHERE (Contract " & " <> '" & newCont & "')"
'
'rst1.Close
'Set rst1 = Nothing
Set daDb = Nothing
DoCmd.RunSQL strSQL
DoCmd.OpenForm "frmContracts"
End Sub
Related
an access newbie here. I am trying to write a VBA code to query from an SQL database, and append the values into an access table. For this, i wrote below code but so far, i could only write a query and create a connection to the server. But i don't know how to bring it into the access table. Can you help me with this?
Sub getInv()
Dim RowCount As Long, ColCount As Long
Dim cnn As Object
Dim RS As Object
Set cnn = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
Dim SQLQuery As String
SQLQuery = _
"SELECT " & _
"PSDDD.SDDPP, PSDDD.SPPRD " & _
"WHERE " & _
"PSDDD.SDDPP = '2244556'" & _
"ORDER BY " & _
"PSDDD.SDDPP ASC, PSDDD.SPPRD DESC "
ConnectString = _
"DRIVER={Client Access ODBC Driver (32-bit)};" & _
"UID=abbsx;PWD=password;" & _
"SYSTEM=ABCSQT;DBQ=SSTNCHP22DB;"
cnn.Open (ConnectString)
RS.Open SQLQuery, cnn
' I believe i should put the code for writing into access table here.
'Close the Recordset and Connection
RS.Close
cnn.Close
Set RS = Nothing
Set cnn = Nothing
Exit Sub
erden. I hope this code gives you inspiration to solve your problem.
Public Function appendSelectedStudentsIntoPoolTable(Interest As String) As Long
Dim rSQL As String, rParams As String
Dim aSQL As String, aParams As String
Dim sourceTable As String, targetTable As String
sourceTable = "tStudents"
targetTable = "tStudentsPool"
'Note for targetTable: ID column not set to autonumber because to preserve
'original data as in the source table. But you can use it as PK as long no
'duplication on IDs.
rParams = "PARAMETERS [par_interest] Text(50); "
rSQL = rParams & "SELECT ID, Email, FirstName " & _
"FROM " & sourceTable & _
" WHERE Interest = par_interest;"
aParams = "PARAMETERS [par_ID] Long, [par_Email] Text(255), " & _
"[par_FirstName] Text(50); "
aSQL = aParams & "INSERT INTO " & targetTable & _
" (ID, Email, FirstName) " & _
"VALUES (par_ID, par_Email, par_FirstName);"
Dim db As DAO.Database
Dim rQDf As DAO.QueryDef
Dim aQdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim rec As Variant
Dim rsCount As Long 'change data type as needed
Dim appendedCount As Long 'same as rsCount data type
Dim i As Long 'same as rsCount data type
'On Error GoTo commit_failed
Set db = CurrentDb
Set rQDf = db.CreateQueryDef("", rSQL)
rQDf.Parameters("par_interest") = Interest
Set rs = rQDf.OpenRecordset()
With rs
On Error Resume Next: .MoveLast
On Error Resume Next: .MoveFirst
If .RecordCount > 0 Then
Do While Not rs.EOF
Set aQdf = db.CreateQueryDef("", aSQL)
aQdf.Parameters("par_ID") = !ID
'add routine(s) to check existing ID on pool table here
'before record append to pool table
'to prevent duplicate ID. For now, i skip it.
aQdf.Parameters("par_Email") = !Email
aQdf.Parameters("par_FirstName") = !FirstName
aQdf.Execute dbFailOnError
aQdf.Close
appendedCount = appendedCount + 1
.MoveNext
Loop
.Close
rQDf.Close
End If
End With
appendSelectedStudentsIntoPoolTable = appendedCount: Exit Function
commit_failed:
appendSelectedStudentsIntoPoolTable = 0
'You can put error handler here
End Function
I have made this form in Access and I am hoping to do the following task.
The list box here contains two columns, and can be multi-selected. I want to use the values second column (the right column) and pass them into a query that I set up for the "test2" button below.
And here is my VBA code for the on-click event for the button.
Private Sub test2_Click()
Dim db As dao.Database
Dim qdef As dao.QueryDef
Dim strSQL As String
Set db = CurrentDb
'Build the IN string by looping through the listbox
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & "'" & Select_Counties2.Column(1, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Set qdef = db.CreateQueryDef("User query results", strSQL)
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub
I was getting this error:
Can someone tell me what I did wrong in the code? Thank you!
In this example from microsoft they call application.refreshwindow without explanation.
https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/database-createquerydef-method-dao
What I think is going on is that your code fails because access cannot find the query that was just added to it's collection of queries. Also your generated sql is no longer valid.
So: replace my sql with your own valid sql
Private Sub test2_Click()
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim strSQL As String
strSQL = "PARAMETERS GEOID Number; " 'without valid sql this code doesn't run so
'replace my sql with your own.
strSQL = strSQL & "SELECT GEOID FROM Counties"
Set db = CurrentDb
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & Select_Counties2.Column(1, i) & ","
End If
Next i
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Debug.Print strSQL
'now the important bit:
db.CreateQueryDef ("User query results") 'create the query
Application.RefreshDatabaseWindow 'refresh database window so access knows it has a new query.
'query will now be visible in database window. make sure to delete the query between runs
'Access will throw an error otherwise
Set qdef = db.QueryDefs("User query results")
qdef.SQL = strSQL
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub
Within the following code
Dim sqlStr As String
Dim OrgID As Long
Dim wrk As DAO.Workspace
Dim db As DAO.Database
Dim orgRS As DAO.Recordset
Dim staffRS As DAO.Recordset
Set wrk = DBEngine.Workspaces(0)
Set db = CurrentDb
On Error GoTo trans_Err
InsertOrganizationIntoTemp
'if staff fields are not blank Insert Staff into Temp
If (addStaffClickCheck = True) Then
staffNumber = staffNumber + 1
InsertStaffIntoTemp staffNumber
End If
wrk.BeginTrans
sqlStr = "INSERT INTO tblOrganization(OrganizationName, Affiliate, " _
& " UnionCouncil, DateJoined, OrganizationPhoneNumber, OrganizationFaxNumber, " _
& " MembershipGroup, TradeGroup, URL) " _
& " SELECT OrganizationName, Affiliate, CouncilUnion, DateJoined, OrganizationPhone, " _
& " OrganizationFax, MemberGroup, Trade, OrganizationWebsite " _
& " FROM tblTempOrganization;"
db.Execute sqlStr
OrgID = db.OpenRecordset("SELECT ##IDENTITY")(0)
sqlStr = "INSERT INTO tblAddresses(StreetName, CityName, StateName, " _
& " ZipCode, LocationID, OrganizationID) " _
& " SELECT OrganizationAddress, OrganizationCity, OrganizationState, " _
& " OrganizationZIP, OrganizationLocationType, '" & OrgID & "' " _
& " FROM tblTempOrganization;"
db.Execute sqlStr
'pull all staff and phones into two recordsets
'loop through staff and for each staff member add associated phone information
'Recordsets for temporary staff tables
Dim staffTempInfoRS As DAO.Recordset
Dim phoneTempInfoRS As DAO.Recordset
Set staffTempInfoRS = db.OpenRecordset("SELECT * FROM tblTempStaff", dbOpenDynaset)
'Recordsets for permanant staff tables
Dim StaffAddressID As Long
Dim StaffID As Long
'Check to see if the recordset actually contains rows
If Not (staffTempInfoRS.EOF And staffTempInfoRS.BOF) Then
staffTempInfoRS.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until staffTempInfoRS.EOF = True
'address information
Dim staffAddressDBRS As DAO.Recordset
Set staffAddressDBRS = db.OpenRecordset("tblStaffAddresses", dbOpenDynaset)
With staffAddressDBRS
.AddNew
.Fields("StaffStreet") = staffTempInfoRS.Fields("StaffStreet")
.Fields("StaffCity") = staffTempInfoRS.Fields("StaffCity")
.Fields("StaffState") = staffTempInfoRS.Fields("StaffState")
.Fields("StaffZip") = staffTempInfoRS.Fields("StaffZip")
.Update
End With
StaffAddressID = staffAddressDBRS.LastModified
staffAddressDBRS.Close
Set staffAddressDBRS = Nothing
'staff information
Dim staffInfoDBRS As DAO.Recordset
Set staffInfoDBRS = db.OpenRecordset("tblStaff", dbOpenDynaset)
With staffInfoDBRS
.AddNew
.Fields("StaffFirstName") = staffTempInfoRS.Fields("StaffFirstName")
.Fields("StaffLastName") = staffTempInfoRS.Fields("StaffLastName")
.Fields("Email") = staffTempInfoRS.Fields("Email")
.Fields("StaffAddressID") = StaffAddressID
.Fields("OrganizationID") = OrgID
.Fields("Position") = staffTempInfoRS.Fields("StaffPosition")
.Update
End With
Dim currPos As Long
currPos = staffTempInfoRS.Fields("StaffNumber")
StaffID = staffInfoDBRS.LastModified
staffInfoDBRS.Close
Set staffInfoDBRS = Nothing
'staff phone information
Set phoneTempInfoRS = db.OpenRecordset("SELECT * FROM tblTempPhones WHERE StaffNumber = " & currPos & ";")
If Not (phoneTempInfoRS.EOF And phoneTempInfoRS.BOF) Then
phoneTempInfoRS.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until phoneTempInfoRS.EOF = True
Dim phoneInfoDBRS As DAO.Recordset
Set phoneInfoDBRS = db.OpenRecordset("tblStaffPhoneNumbers", dbOpenDynaset)
With phoneInfoDBRS
.AddNew
.Fields("PhoneNumber") = phoneTempInfoRS.Fields("StaffPhoneNumber")
.Fields("PhoneTypeID") = phoneTempInfoRS.Fields("PhoneType")
.Fields("StaffID") = StaffID
.Update
End With
phoneTempInfoRS.MoveNext
Loop
Else
Resume Next
End If
MsgBox "Finished looping through phone records."
phoneTempInfoRS.Close
Set phoneTempInfoRS = Nothing
'Move to the next record. Don't ever forget to do this.
staffTempInfoRS.MoveNext
Loop
Else
MsgBox "There are no records in the staff recordset."
End If
MsgBox "Finished looping through staff records."
staffTempInfoRS.Close 'Close the recordset
Set staffTempInfoRS = Nothing 'Clean up
wrk.CommitTrans
trans_Exit:
'Clean up
wrk.Close
Set db = Nothing
Set wrk = Nothing
Exit Function
trans_Err:
'Roll back the transaction
MsgBox "Whoops! We got errors"
wrk.Rollback
Resume trans_Exit
When I step through this I get an error in this line:
.Fields("StaffStreet") = staffTempInfoRS.Fields("StaffStreet")
That says:
Item not found in collection.
However, this is the exact field name that is in the table that the recordset is set to open.
30 hours later it seems I suffered a rookie mistake and in-spite of repeated checking missed that the field names were indeed misspelled.
I also set the recordsets outside of the loops and I unset them all in the exit snippet...
I want to execute a select statement and put the result of it (which is only 1 record with 1 value) in a variable.
This is in VBA code in access.
Private Sub Child_Click()
Dim Childnummer As Integer
Dim childnaam As String
Childnummer = Me.Keuzelijst21.Value
DoCmd.Close
DoCmd.OpenForm "submenurubrieken", acNormal, , " rubrieknummer = " & Childnummer & ""
childnaam = rubrieknaamSQL(Childnummer)
Forms!submenurubrieken.Tv_rubrieknaam.Value = childnaam
End Sub
Public Function rubrieknaamSQL(Child As Integer)
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT rubrieknaam FROM dbo_tbl_rubriek where rubrieknummer = " & Child & ""
Set rst = CurrentDb.OpenRecordset(strSQL)
End Function
Simply have your Function return the value from the Recordset:
Public Function rubrieknaamSQL(Child As Integer)
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT rubrieknaam FROM dbo_tbl_rubriek where rubrieknummer = " & Child & ""
Set rst = CurrentDb.OpenRecordset(strSQL)
' new code:
rubrieknaamSQL = rst!rubrieknaam
rst.Close
Set rst = Nothing
End Function
You can do this in pretty much one line by using the "DLookup" Function
rubrieknaam = Nz(DLookup("rubrieknaam ", "dbo_tbl_rubriek ", rubrieknummer & " =[Child]"), 0)
where Child is the ID of the record you are looking for.
I have a userform with one textbox and one combobox in EXCEL.
This userform is connected to a small data base (one table with 2 columns)
Combobox is populated with the values from the first column of databasqe table
I like when the combobox is changing the textbox to be automatic populated with the corespondent value from the second column.
I have the following code but it is not working:
Please, can someone help me?
Sub PopulateTB()
Dim rs As Recordset
Dim db As database
Dim SQL As String
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
SQL = "SELECT values_col2 FROM table_db WHERE values_col1 = " & UserForm1.ComboBox1.Value & ";"
Set rs = db.OpenRecordset(sql)
Do Until rs.EOF = True
UserForm1.TextBox1.Value = rs.Fields(SQL)
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Set rs = Nothing
End Sub
Thank you!
I putted like this and it is ok
Sub PopulateTB(ByRef ctl As Control, ByVal strTable As String, ByVal strField As String, Optional ByVal strCriteria As String)
Dim strSQL As String
Dim strSQLcount As String
Dim rs As Recordset
Dim db As Database
Dim rsCount As Recordset, totalCol As Long
Dim varRecords As Variant
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
strSQLcount = ""
strSQLcount = strSQLcount & " " & "SELECT COUNT(*) AS Total FROM " & "[" & strTable & "]"
Set rsCount = db.OpenRecordset(strSQLcount)
totalCol = rsCount!Total
rsCount.Close
Set rsCount = Nothing
strSQL = ""
strSQL = strSQL & " " & "SELECT" & "[" & strField & "]"
strSQL = strSQL & " " & "FROM " & "[" & strTable & "]"
Set rs = db.OpenRecordset(strSQL)
varRecords = rs.GetRows(totalCol)
ctl.Value = varRecords(0, Me.ComboBox1.ListIndex)
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub