I'm trying to compare each field in a row in one table and each field in a row in another table using a recordset. I think iv got pretty close(Big I think) but I'm getting hung up on the If statement. Ps, I got thrown into doing this and I'm flying by the seat of my pants. So if I am doing something wrong I apologize. Iv self-taught myself this for the last 2 months. I am a Desktop technician...... I have literally spent my evenings and weekends watching youtube videos and surfing forums.
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim strSQL As String
Dim fld As DAO.Field
Dim OutagesChanged As String
strSQL = " "
strSQL = strSQL & " SELECT Outages.OutageID, ORH.OutageID, Outages.Outage, Outages.Building, Outages.OutageType, Outages.OutageStart, Outages.OutageStartTime, Outages.OutageEnd, "
strSQL = strSQL & " Outages.OutageEndTime, Outages.Duration, Outages.Reason, Outages.Areas, Outages.Comment, Outages.Contact, Outages.Phone, ORH.*, "
strSQL = strSQL & " ORH.Outage, ORH.Building, ORH.OutageType, ORH.OutageStart, ORH.OutageStartTime, "
strSQL = strSQL & " ORH.OutageEnd, ORH.OutageEndTime, ORH.Duration, ORH.Reason, ORH.Areas, ORH.Comment, ORH.Contact, ORH.Phone, ORH.Job, Outages.Job "
strSQL = strSQL & " FROM Outages INNER JOIN ORH ON Outages.OutageID = ORH.OutageID "
strSQL = strSQL & " WHERE (((Outages.OutageID)=" & Me.OutageID & ") AND ((ORH.OutageID)=" & Me.OutageID & ")); "
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
Do While Not rst.EOF
For Each fld In rst.Fields
'This is where I am getting hung up.
If rst.Fields(Outages.Outage) = rst.Fields(ORH.Outages) Then
OutagesChanged = False
MsgBox "the same"
Else
OutagesChanged = True
MsgBox "not the same"
End If
Next fld
rst.Close
Loop
Related
I have a database that worked perfectly before, but today for some reason it has this error:
run time error 3464 data type mismatch
When I click debug, it pointed out the line that has the error:
Set rst = CurrentDb().OpenRecordset(strSQL)
How could I fix it? Thank you!!!!
Below is my code:
Function DmdQtyThruDate(ItemVar As String, DatePeg As Date) As Double
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Sum(TotQty) AS TotTotQty "
strSQL = strSQL & "FROM ("
strSQL = strSQL & "SELECT DISTINCTROW Sum([dbo_apsplan].[qty]) AS TotQty "
strSQL = strSQL & "FROM [dbo_apsplan] LEFT JOIN [dbo_job_sch] ON (([dbo_apsplan].[ref_line_suf] = [dbo_job_sch].[suffix]) AND ([dbo_apsplan].[ref_num] = [dbo_job_sch].[job])) "
strSQL = strSQL & "WHERE ([dbo_apsplan].[item]='" & ItemVar & "' AND [dbo_apsplan].[is_demand]=1 AND DateValue(IIf([dbo_apsplan].[ref_type]='j',[dbo_job_sch].[start_date],[dbo_apsplan].[due_date]))<=DateValue(#" & DatePeg & "#)) "
strSQL = strSQL & "UNION ALL "
strSQL = strSQL & "SELECT Sum([qty_ordered]-[qty_shipped]) AS TotQty "
strSQL = strSQL & "FROM [dbo_coitem] "
strSQL = strSQL & "WHERE (([item]='" & ItemVar & "') AND ([ref_num]is null) AND ([stat]='o' Or [stat]='p') AND (DateValue([due_date])<=DateValue(#" & DatePeg & "#)))); "
Set rst = CurrentDb().OpenRecordset(strSQL)
If rst.EOF = False Then
DmdQtyThruDate = Nz(rst("TotTotQty"), 0)
Else
DmdQtyThruDate = 0
End If
rst.Close
Set rst = Nothing
End Function
Consider using parameterized stored queries which is more efficient than VBA run queries especially with JOIN and UNION since Access engine saves best execution plan. This also helps avoid concatenation of SQL and VBA, enhances readability and maintainability, and better aligns data types.
SQL (save as a stored query; PARAMETERS clause is supported in Access SQL)
PARAMETERS prmItemVar Text, prmDatePeg Date;
SELECT SUM(TotQty) AS TotTotQty
FROM (
SELECT SUM(a.[qty]) AS TotQty
FROM [dbo_apsplan] a
LEFT JOIN [dbo_job_sch] j
ON ((a.[ref_line_suf] = j.[suffix])
AND (a.[ref_num] = j.[job]))
WHERE a.[item] = prmItemVar
AND a.[is_demand]=1
AND DateValue(IIf(a.[ref_type] = 'j', j.[start_date], a.[due_date])
) <= prmDatePeg
UNION ALL
SELECT SUM([qty_ordered] - [qty_shipped]) AS TotQty
FROM [dbo_coitem]
WHERE [item] = prmItemVar
AND [ref_num] IS NULL
AND ([stat]='o' OR [stat]='p')
AND DateValue([due_date]) <= prmDatePeg
);
VBA
Function DmdQtyThruDate(ItemVar As String, DatePeg As Date) As Double
Dim qDef As DAO.QueryDef
Dim rst As DAO.Recordset
Dim strSQL As String
' INITIALIZE QUERYDEF
Set qDef = CurrentDb.QueryDefs("mySavedQuery")
' BIND PARAMETERS
qDef!prmItemVar = ItemVar
qDef!prmDatePeg = DatePeg
' OPEN RECORDSET
Set rst = qDef.OpenRecordset()
If rst.EOF = False Then
DmdQtyThruDate = Nz(rst("TotTotQty"), 0)
Else
DmdQtyThruDate = 0
End If
rst.Close
Set rst = Nothing: Set qDef = Nothing
End Function
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
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
I have looked and looked for an answer and cannot translate the answers to my specific code. I have some code for an Access Database that works as an INSERT TO but I want it to UPDATE a table. I cannot get it to run after changing it to UPDATE.
The following code works and what it does is add values that meet the criteria to the beginning of an existing table. But I want it to update the existing blank column "O_StateRegion" in a table called "Sonoco2016_xlsx". My efforts of switching INSERT INTO to UPDATE have failed. (See second example of code for my efforts)
Private Sub InsertStateRegion()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SELECT [StateRegion] FROM [tblStates]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev]='" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
Below are my efforts to convert it to UPDATE
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev] = '" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
The correct syntax for what you want to achieve is
UPDATE [Sonoco2016_xlsx]
INNER JOIN [tblStates]
ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]
SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion];
which you would execute without using a recordset.
Note, however, that this will only work if [StateAbbrev] has a unique index, e.g. if it is the primary key of [tblStates]. Otherwise, the update would be ambiguous.
Moreover, it is not possible to use a subquery in the set statement like
SET [Sonoco2016_xlsx].[O_StateRegion]=(SELECT [StateRegion]
FROM = [tblStates]
WHERE [StateAbbrev] = rs![OriginState])
because subqueries are prohibited in UPDATE statements.
Here is the answer that worked for me thanks to M Doerner!
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] INNER JOIN [tblStates]"
strSQL = strSQL & " ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
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