VBA check if distinct values from 2 fields match - sql

I'm VERY new to VBA but have some coding experience so I'm slowly starting to learn. I have two tables in my access database that each have one field that is the same. One table is a distinct list of the possible values ("TOSITEXREF")that could show up in the same field on the other table ("Trans_Earned"). This function I am trying to create will run in a macro to figure out whether or not the data that is being appended via queries has an instance in the ToLocn field that is not on the list of possible values. Here is what I have so far, but is not working:
Function TESTING()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("TransEarned")
Dim rs2 As DAO.Recordset
Set rs2 = CurrentDb.OpenRecordset("TOSITEXREF")
Dim cond1A As Boolean
cond1A = (rs.Fields("ToLocn") = rs2.Fields("ToLoc"))
If cond1A Then
DoCmd.OpenQuery "Earns", acViewNormal, acEdit
Else
DoCmd.CancelEvent
MsgBox "Unknown ToLocation, Please Update TOSITEXREF File to acccount for new location", vbOKOnly, "NEW LOCATION"
End If
Set rs = Nothing
Set rs2 = Nothing
End Function

Final VBA example that will return a value in the Loc field from table1 that does not show up in the Loc field of Table2:
Function Validate()
Dim sql As String
Dim rs As DAO.Recordset
sql = "SELECT Table1.Loc FROM Table1 LEFT JOIN Table2 ON Table1.Loc = Table2.Loc WHERE (((Table2.Loc) Is Null))"
Set rs = CurrentDb.OpenRecordset(sql)
If (rs.RecordCount = 0) Then
MsgBox "WORKS", vbkokonly, "WORKS"
Else
MsgBox "DOES NOT WORK", vbkokonly, "DOES NOT WORK"
Set rs = Nothing
End If
End Function

Related

How to iterate through a recordset and do a lookup

I need to iterate through a record set but when it gets to a user name field I want to do a lookup to a user ID table to pull in the actual name. Then end loop when cusip column is null?
You can iterate over a recordset which already includes the actual name by opening a recordset for a SQL statement such as:
select * from tblImport inner join tblUser on tblImport.UserID = tblUser.ID
The code might look something like:
Sub MySub()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim flg As Boolean
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("select * from tblImport inner join tblUser on tblImport.UserID = tblUser.ID")
With rst
If Not .EOF Then
.MoveFirst
Do Until .EOF Or flg ' No short-circuit evaluation in VBA
flg = IsNull(!Cusip)
.MoveNext
Loop
End If
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End Sub
You'll need to change the field & table names to suit your data.
You haven't stated what you actually want to do with the data within the loop.

Error executing a saved Access query that depends on parameter values from a form

I'm trying to simply open a query and SELECT everything from it. The query requires FROM and TO dates. I have a frmA through which I pass the parameters to the query. I open the frmA and put in 2 dates. Funny thing is, when I do docmd.openQuery "qryInsurance" it opens it wihout a problem, however, when I try to Select * from qryInsurance, it tells me that it's expecting 2 parameters.
here is the code:
Public Function CountFollowup() As Boolean
On Error GoTo error_handler:
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim strsql As String
Dim rcount As Integer
Set DB = CurrentDb
CountFollowup = False
DoCmd.OpenQuery "qryInsurance"
strsql = "SELECT * FROM [qryInsurance];"
'CurrentDb.Execute "Delete * FROM temp_InsData"
Set rs1 = CurrentDb.OpenRecordset(strsql, , dbOpenSnapshot) ' here is where it gives me an ERROR, expecting 2 parameters when it OPENS it fine before strsql
Set rs2 = CurrentDb.OpenRecordset("temp_InsData")
Debug.Print strsql
Exit Function
error_handler:
MsgBox Err.Number & " - " & Err.Description
End Function
It seems qryInsurance includes references to form controls, maybe like this ... Forms!frmA!From
Those references are resolved when you use DoCmd.OpenQuery, but not when you use the DAO.Database.OpenRecordset method. With OpenRecordset, they are interpreted as parameters for which you have not supplied values.
If you open the query's QueryDef and then feed each parameter Name to Eval(), it will give you the values of those form controls ... so you can then supply them as the values for the parameters.
That description may not be easy to follow, but the code is pretty easy.
Add these variable declarations before Set db = CurrentDb ...
Dim db As DAO.Database
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Dim CountFollowup ' As what? Boolean?
Then later ...
Set db = CurrentDb
CountFollowup = False
'DoCmd.OpenQuery "qryInsurance"
'strsql = "SELECT * FROM [qryInsurance];"
'CurrentDb.Execute "Delete * FROM temp_InsData"
Set qdf = db.QueryDefs("qryInsurance")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next
'Set rs1 = CurrentDb.OpenRecordset(strsql, , dbOpenSnapshot) ' here is where it gives me an ERROR, expecting 2 parameters when it OPENS it fine before strsql
Set rs1 = qdf.OpenRecordset(dbOpenSnapshot)
' and the rest ...

Updating table with VBA

I have been struggling with getting this code to work for a few days. If you could offer any solutions I would really appreciate it.
Private Sub Command0_Click()
If IsNull(NewSupBox.Value) Or IsNull(NewNumberBox.Value) Then
MsgBox ("All fields must be filled")
GoTo ErrorExit
End If
If Not IsNull(DLookup("SupplierNumber", "SupGenInfo ", "SupGenInfo.SupplierNumber =" & NewSupBox)) = Then
MsgBox ("This supplier number already exists. You can edit the current record on the Edit supplier page.")
GoTo ErrorExit
End If
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("select * from SupGenInfo")
rec.AddNew
rec("SupplierNumber") = Me.NewSupBox.Value
rec("SupplierName") = Me.NewNameBox.Value
rec.Update
Set rec = Nothing
Set db = Nothing
MsgBox "Records added successfully."
ErrorExit:
End Sub
Edit: Forgot to mention that I am not getting any error message. The command will simply not add a new record to my table.
Edit2: The code above will output the msg "Records Added Successfully" when i remove the following block of code.
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("SupGenInfo")
rec.AddNew
rec("SupplierNumber") = Me.NewSupBox
rec("SupplierName") = Me.NewNameBox
rec.Update
Set rec = Nothing
Set db = Nothing
It is when this code is included that my command click becomes unresponsive.
I believe, you are reading a table (for display purposes) with your select * ... statement, then you're adding a new record to that list rather than the actual database. When you open OpenRecordset, just supply the table name, not a whole SQL query shebang...
I created a new table, so edit this code to match your parameters/values, otherwise this has been tested to work:
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("Table1")
rec.AddNew
rec("Field1") = 1234
rec("Field2") = "blah2"
rec("Field3") = "blah3"
rec.Update
Set rec = Nothing
Set db = Nothing
Hope this helps.

Access VBA Recordset

I have an access database that contains a table with employee information. My issue is that I want to loop through another table in order to determine if a specific characteristic is true or false first, then display all the records that are true in a continous form. It still populates all the records not just the ones that are true. Please see code below.
Private Sub RunQuery_Click()
Dim strSQL As String
Dim dba As Database
Dim tbl As Recordset
Dim Code As String
Dim status As String
Set dba = CurrentDb
strSQL = "SELECT DISTINCT EmployeeName,SSN,Location,SystemAssignedPersonID FROM dbo_tbl_Random "
strSQL = strSQL & "WHERE MenuUsed = 'Random' ORDER BY Location,EmployeeName"
Set tbl = dba.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
With tbl
.MoveFirst
If tbl.EOF Then
MsgBox "There are no employees on Random at this time.", , "Oops! Try Again"
Else
Do Until tbl.EOF
status = getEmpStatusID(tbl!SystemAssignedPersonID)
If status = "A" Then
Set Me.Recordset = tbl
.MoveNext
Else
.MoveNext
End If
Loop
End If
End With
Set tbl = Nothing
Set dba = Nothing
End Sub
The getEmpStatusID is a seperate function that is not giving me trouble. It looks up the Employee ID to get the information and returns it fine.
Thanks for the help!
I think you're most of the way there already. Depending on what getEmpStatusID does you can do something like this
SELECT DISTINCT EmployeeName,SSN,Location,T.SystemAssignedPersonID
FROM dbo_tbl_Random R
Inner JOin Table_Where_Status_Is_Found as T
on T.SystemAssignedPersonID = R.SystemAssignedPersonID
WHERE MenuUsed = 'Random' and T.SystemAssignedPersonID = 'A'
ORDER BY Location,EmployeeName
Use that as the rowsource for your form and don't use VBA. Your form will not be updatable because you used distinct, though. Is that necessary?

Errors with linked tables and Ms Access ( Run-time error '3622' : dbSeeChanges/Identity column )

I am trying to output the name of all linked tables, including their fields which are Date/Time, and that fields values.
The following code can output the first table, field name and their first value, not all values, although when it gets to the next linked table, I get this error
Run-time Error '3622'
You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server table that has an IDENTITY column.
Here is my code
Private Sub btnGetFields_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim f As Field
Dim rst As DAO.Recordset
Dim numField As Integer
Set db = CurrentDb
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 9) = "ODBC;DSN=" Then
Set rst = CurrentDb.OpenRecordset(tdf.Name)
numField = rst.Fields.Count
Debug.Print "Table: " & tdf.Name
For index = 0 To numField - 1
If rst.Fields(index).Type = dbDate Then
Debug.Print "Field: " & rst.Fields(index).Name; " Value : "; rst.Fields(index).Value
End If
Next
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub
I read something that if I'm using sql tables I should use ADO?
Any ideas?
You can continue to use your existing DAO code, just change
Set rst = CurrentDb.OpenRecordset(tdf.Name)
to
Set rst = CurrentDb.OpenRecordset(tdf.Name, dbOpenSnapshot)
That opens a static read-only Recordset, so dbSeeChanges is not required.