SetFocus is getting ignored - Why? - vba

I have 2 fields - txtTR1_Unit and cmbTR2_Unit. Together, these 2 fields represent the total UNIT.
cmbTR2_Unit has a list of unique values that when selected - txtTR1_Unit automatically gets the related value.
I've created a function called Tier1from2 - that accepts a 'string' and returns the related Tier1 value.
So when I update cmbTR2_Unit in my After_Update event, I'd like to automatically tab to the next field. - Another combo box. I figured that I shouldn't need to set any focus, because it would automatically go to the next field after updating.
txtTR1 gets updated just as expected from my Function, but then it just sits there and won't go to the next field. So I have attempted to 'SetFocus' to the next field after the update.
Still no go. What did I miss??
Private Sub cmbTR2_UNIT_AfterUpdate()
If Len(Me.cmbTR2_UNIT.Value) <> 0 Then
Me.txtTR1_UNIT.Value = Tier1From2(Me.cmbTR2_UNIT.Text)
'cmb_CostCenter.setfocus - 'this doesn't seem necessary - but it doesn't work anyway.
End If
End Sub
As a test I tried removing the function "Tier1From2(Me.cmbTR2_UNIT.text)" simply hard coding the word 'RESULT' in txtTR1_UNIT and it works without a hitch. I know I used to write a more simple function but I haven't touched VBA in awhile - How can I simplify this function:
Private Function Tier1From2(strTier2 As String) As String
Dim qdf As DAO.QueryDef
Dim db As DAO.Database
Dim strQry As String
Dim rs As Recordset
Set db = CurrentDb
Set qdf = db.QueryDefs("qUNIT_HUB")
strQry = "SELECT Tier1_Unit, Tier2_Unit " & _
" FROM LTBL_Cost_Collector " & _
" GROUP BY Tier1_Unit, Tier2_Unit " & _
" HAVING (((Tier2_Unit) = '" & strTier2 & "'));"
qdf.SQL = strQry
db.QueryDefs.Refresh
Set rs = db.OpenRecordset(strQry)
Tier1From2 = rs![Tier1_Unit]
Set db = Nothing
Set qdf = Nothing
Set Recordset = Nothing
End Function

It turns out that something in this function was causing the field and form to loose focus. db.QueryDefs.refresh perhaps? The solution was to update my Function as follows
Private Function Tier1From2(strTier2 As String) As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim strTier1 As String
Set db = CurrentDb
strSQL = "SELECT Tier1_Unit, Tier2_Unit " & _
" FROM LTBL_Cost_Collector " & _
" GROUP BY Tier1_Unit, Tier2_Unit " & _
" HAVING (((Tier2_Unit) = '" & strTier2 & "'));"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
strTier1 = rs!Tier1_Unit
Set rs = Nothing
Set db = Nothing
Tier1From2 = strTier1
End Function
This worked without a hitch.

Related

Check if table in Oracle database is empty using VBA and SQL COUNT(*)

I need how to find if a given table is empty in an Oracle database (Oracle 11g) to be specific using VBA inside of PowerAdmin Server Monitor's "run script" feature.
SELECT COUNT(*) FROM table; correctly returns "COUNT(*)" as 0. img of result
I need to find a way to check that result if it is 0 or not.
This is a redacted version of the script colleague uses to access the database for slightly different purposes, I prefer if we could continue from this
Dim strConnect
Dim strSQL
Dim adoConnection
Dim adoRecordset
strConnect = "Driver={Oracle in OraClient11g_home1_32bit};" & _
"Dbq=database;" & _
"Uid=user;" & _
"Pwd=password"
strSQL = "SELECT COUNT(*) FROM table;;"
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Open strConnect
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.ActiveConnection = adoConnection
adoRecordset.Source = strSQL
adoRecordset.Open
[check if query result is the number 0 here]
adoRecordset.Close
adoConnection.Close
I need something that would look like
If queryresult = 0 then
SendNotification = True
Details = "table is empty"
End If
Any help would be appreciated. The more ELI5 the better.
After you execute a query in ADO, the recordset points to the first record, and you can access the fields of that first record per index (0-based).
The result of your count(*)-query is always one row with one column, holding the number of records. So you can access the number of rows with adoRecordset(0) (=first field of first record)
You could create a function to fetch the number of records:
Const strConnect = "..."
Function CountValues(tableName As String) As Long
Dim strSQL As String
strSQL = "SELECT COUNT(*) FROM " & tableName
Dim adoConnection
Dim adoRecordset
On Error GoTo CountValues_ERROR
Set adoConnection = CreateObject("ADODB.Connection")
Set adoRecordset = CreateObject("ADODB.Recordset")
adoConnection.Open strConnect
adoRecordset.ActiveConnection = adoConnection
adoRecordset.Source = strSQL
adoRecordset.Open
Dim res
res = adoRecordset(0)
CountValues = CLng(res)
GoTo CountValues_EXIT
CountValues_ERROR:
MsgBox "An error occurred fetching data: " & Err.Number & " " & Err.Description
CountValues_EXIT:
If adoRecordset.State <> 0 Then adoRecordset.Close
If adoConnection.State <> 0 Then adoConnection.Close
End Function
N.B.: If I where you, I would switch to early binding. Add a reference to the ADODB library and use
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.RecordSet
Set adoConnection = new ADODB.Connection
Set adoRecordset = new ADODB.RecordSet

AfterUpdate - combine multiple actions

I hope you can help, I am new to VBA, but eager to learn. I have created a form which adds a Document Number to my database (field name DocNum). I created an "afterupdate" event for that field to create a corresponding record on each table which will hold additional information for that document ID. See code here:
Private Sub DocNum_AfterUpdate()
Dim TBL_3_ManuscriptPrimaryReviewer As DAO.Recordset
Set TBL_3_ManuscriptPrimaryReviewer = CurrentDb.OpenRecordset("Select * FROM [TBL_3_ManuscriptPrimaryReviewer]")
TBL_3_ManuscriptPrimaryReviewer.AddNew
TBL_3_ManuscriptPrimaryReviewer![Manuscript_Number] = Me.DocNum.Value
TBL_3_ManuscriptPrimaryReviewer.Update
TBL_3_ManuscriptPrimaryReviewer.Close
Set TBL_3_ManuscriptPrimaryReviewer = Nothing
End Sub
Private Sub DocNum_AfterUpdate()
Dim TBL_4_ManuscriptSTATReviewer As DAO.Recordset
Set TBL_4_ManuscriptSTATReviewer = CurrentDb.OpenRecordset("Select * FROM [TBL_4_ManuscriptSTATReviewer]")
TBL_4_ManuscriptSTATReviewer.AddNew
TBL_4_ManuscriptSTATReviewer![Manuscript_Number] = Me.DocNum.Value
TBL_4_ManuscriptSTATReviewer.Update
TBL_4_ManuscriptSTATReviewer.Close
Set TBL_4_ManuscriptSTATReviewer = Nothing
End Sub
Private Sub DocNum_AfterUpdate()
Dim TBL_5_ManuscriptSCReview As DAO.Recordset
Set TBL_5_ManuscriptSCReview = CurrentDb.OpenRecordset("Select * FROM [TBL_5_ManuscriptSCReview]")
TBL_5_ManuscriptSCReview.AddNew
TBL_5_ManuscriptSCReview![Manuscript_Number] = Me.DocNum.Value
TBL_5_ManuscriptSCReview.Update
TBL_5_ManuscriptSCReview.Close
Set TBL_5_ManuscriptSCReview = Nothing
End Sub
Private Sub DocNum_AfterUpdate()
Dim TBL_6_ManuscriptPublications As DAO.Recordset
Set TBL_6_ManuscriptPublications = CurrentDb.OpenRecordset("Select * FROM [TBL_6_ManuscriptPublications]")
TBL_6_ManuscriptPublications.AddNew
TBL_6_ManuscriptPublications![Manuscript_Number] = Me.DocNum.Value
TBL_6_ManuscriptPublications.Update
TBL_6_ManuscriptPublications.Close
Set TBL_6_ManuscriptPublications = Nothing
End Sub
However, I get the following error when I try to use the form:
"The expression After Update you entered as the event property setting produced the following error: Ambiguous name detected: DocNum_AfterUpdate."
After doing some research, I tried rewriting the code as one Private Sub, instead of four, as shown here:
Private Sub DocNum_AfterUpdate()
Dim TBL_3_ManuscriptPrimaryReviewer As DAO.Recordset
Set TBL_3_ManuscriptPrimaryReviewer = CurrentDb.OpenRecordset("Select * FROM [TBL_3_ManuscriptPrimaryReviewer]")
TBL_3_ManuscriptPrimaryReviewer.AddNew
TBL_3_ManuscriptPrimaryReviewer![Manuscript_Number] = Me.DocNum.Value
TBL_3_ManuscriptPrimaryReviewer.Update
TBL_3_ManuscriptPrimaryReviewer.Close
Set TBL_3_ManuscriptPrimaryReviewer = Nothing
Dim TBL_4_ManuscriptSTATReviewer As DAO.Recordset
Set TBL_4_ManuscriptSTATReviewer = CurrentDb.OpenRecordset("Select * FROM [TBL_4_ManuscriptSTATReviewer]")
TBL_4_ManuscriptSTATReviewer.AddNew
TBL_4_ManuscriptSTATReviewer![Manuscript_Number] = Me.DocNum.Value
TBL_4_ManuscriptSTATReviewer.Update
TBL_4_ManuscriptSTATReviewer.Close
Set TBL_4_ManuscriptSTATReviewer = Nothing
Dim TBL_5_ManuscriptSCReview As DAO.Recordset
Set TBL_5_ManuscriptSCReview = CurrentDb.OpenRecordset("Select * FROM [TBL_5_ManuscriptSCReview]")
TBL_5_ManuscriptSCReview.AddNew
TBL_5_ManuscriptSCReview![Manuscript_Number] = Me.DocNum.Value
TBL_5_ManuscriptSCReview.Update
TBL_5_ManuscriptSCReview.Close
Set TBL_5_ManuscriptSCReview = Nothing
Dim TBL_6_ManuscriptPublications As DAO.Recordset
Set TBL_6_ManuscriptPublications = CurrentDb.OpenRecordset("Select * FROM [TBL_6_ManuscriptPublications]")
TBL_6_ManuscriptPublications.AddNew
TBL_6_ManuscriptPublications![Manuscript_Number] = Me.DocNum.Value
TBL_6_ManuscriptPublications.Update
TBL_6_ManuscriptPublications.Close
Set TBL_6_ManuscriptPublications = Nothing
End Sub
However, this is not working either. It only updates TBL_6_ManuscriptPublications, and not tables 3, 4, or 5.
I've been searching for about 2 hours on how to have multiple afterupdate events, but nothing seems to be helping. The If>Then doesn't seem to apply, the For>Next doesn't either.
I'd love some help, thanks!
-Deb
Simply run action append queries without any recordsets. And since you are passing values from user input forms, consider paramterization with QueryDefs. And to keep it a DRY-er solution (Don't Repeat Yourself), a function can be used for each query call.
Private Sub DocNum_AfterUpdate()
Dim strSQL
' TBL_3_ManuscriptPrimaryReviewer APPEND
strSQL = "PARAMETERS DocNumParam TEXT(255);" _
& " INSERT INTO [TBL_3_ManuscriptPrimaryReviewer] ([Manuscript_Number]) " _
& " VALUES (DocNumParam)"
Call RunQuery(strSQL)
' TBL_4_ManuscriptSTATReviewer APPEND
strSQL = "PARAMETERS DocNumParam TEXT(255);" _
& "INSERT INTO [TBL_4_ManuscriptSTATReviewer] ([Manuscript_Number]) " _
& " VALUES (DocNumParam)"
Call RunQuery(strSQL)
' TBL_5_ManuscriptSCReview APPEND
strSQL = "PARAMETERS DocNumParam TEXT(255);" _
& "INSERT INTO [TBL_5_ManuscriptSCReview] ([Manuscript_Number]) " _
& " VALUES (DocNumParam)"
Call RunQuery(strSQL)
' TBL_6_ManuscriptPublications APPEND
strSQL = "PARAMETERS DocNumParam TEXT(255);" _
& "INSERT INTO [TBL_6_ManuscriptPublications] ([Manuscript_Number]) " _
& " VALUES (DocNumParam)"
Call RunQuery(strSQL)
End Sub
Public Function RunQuery(stmt As String)
Dim qdef As QueryDef
Set qdef = CurrentDb.CreateQueryDef("", stmt)
' BIND PARAM VALUE
qdef!DocNumParam = Me.DocNumValue
' EXECUTE ACTION
qdef.Execute, dbFailOnError
Set qdef = Nothing
End Function
However, your database design can be optimized with normalization. Instead of multiple similarly structured tables requiring updates and maintenance, use one table (i.e., TBL_REVIEWERS) with indicator such as Type. Further, querying data will be much easier.
ID Type Manuscript_Number ...
1 PrimaryReviewer 12345
2 ManuscriptSTATReviewer 12345
3 ManuscriptSCReview 12345
4 ManuscriptPublications 12345
Then your append query would modify for two values for same query call (even DRY-er).
Private Sub DocNum_AfterUpdate()
Dim var As Variant
Dim strSQL As String
strSQL = "PARAMETERS TypeParam TEXT(255), DocNumParam TEXT(255);" _
& " INSERT INTO [TBL_Reviewers] ([Type], [Manuscript_Number]) " _
& " VALUES (TypeParam, DocNumParam)"
' RUN APPEND QUERIES
For Each var In Array("PrimaryReviewer", "ManuscriptSTATReviewer" _
"ManuscriptSCReview", "ManuscriptPublications")
Call RunQuery(strSQL, var)
Next var
End Sub
Public Function RunQuery(strSQL As String, strType As String)
Dim qdef As QueryDef
Set qdef = CurrentDb.CreateQueryDef("", strSQL)
' BIND PARAM VALUES
qdef!TypeParam = strType
qdef!DocNumParam = Me.DocNumValue
' EXECUTE ACTION
qdef.Execute, dbFailOnError
Set qdef = Nothing
End Function

How to pass a SQL query result to variable with VBA Access

I need to create a standalone function which checks whether a value is true or false. I have attempted to set up a SQL query that does this, but can't get the result to pass to the variable.
The query will always return only one record.
How can I pass the result of the SQL string as the returning value of the function?
UPDATED
Private Function HasBM(iMandate As Variant) As Boolean
'Returns boolean value for whether or not mandate has a benchmark
Dim sSQL1 As String
Dim sSQL2 As String
Dim db As Database
Dim rs As Recordset
sSQL1 = "SELECT tbl_Mandate_Type.BM_Included " & _
"FROM tbl_Mandate_Type INNER JOIN tbl_MoPo_BM ON tbl_Mandate_Type.Mandate_Type_ID = tbl_MoPo_BM.MandateType_ID " & _
"WHERE (((tbl_MoPo_BM.MoPo_BM_ID)="
sSQL2 = "));"
Set db = CurrentDb
Set rs = db.Execute(sSQL1 & iMandate & sSQL2)
HasBM = rs.Fields(0).Value
End Function
UPDATE 2: SOLUTION
Thanks for Magisch and HansUp I ended up getting two solutions that work:
DLOOKUP Solution by Magisch as I implemented it:
Private Function HasBM2(iMandate As Variant)
'Returns boolean value for whether or not mandate has a benchmark
Dim tmp As String
tmp = CStr(DLookup("tbl_MoPo_BM.MandateType_ID", "tbl_MoPo_BM", "tbl_MoPo_BM.MoPo_BM_ID = " & iMandate))
HasBM2 = DLookup("tbl_Mandate_Type.BM_Included", "tbl_Mandate_Type", "Mandate_Type_ID =" & tmp)
End Function
Second Solution using recordset as HansUp helped create:
Private Function HasBM(iMandate As Variant) As Boolean
'Returns boolean value for whether or not mandate has a benchmark
Dim sSQL1 As String
Dim sSQL2 As String
Dim db As Database
Dim rs As dao.Recordset
sSQL1 = "SELECT tbl_Mandate_Type.BM_Included " & _
"FROM tbl_Mandate_Type INNER JOIN tbl_MoPo_BM ON tbl_Mandate_Type.Mandate_Type_ID = tbl_MoPo_BM.MandateType_ID " & _
"WHERE (((tbl_MoPo_BM.MoPo_BM_ID)="
sSQL2 = "));"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL1 & iMandate & sSQL2)
HasBM = rs.Fields(0).Value
rs.close
End Function
You can use the DLookup function native to access for this. Since you have an INNER JOIN in your SQL, you will have to use it twice, but it'll still work.
Use a temporary string variable to store the temporary output, like this:
Dim tmp as String
tmp = Cstr(DLookup("tbl_MoPo_BM.MandateType_ID","tbl_MoPo_BM","tbl_MoPo_BM.MoPo_BM_ID = " & iMandate)) 'This is to fetch the ID you performed the inner join on
HasBM = DLookup("tbl_Mandate_Type.BM_Included","tbl_Mandate_Type","Mandate_Type_ID =" & tmp) ' this is to get your value
Using your DoCmd.RunSQL will not suffice since its for action queries only (INSERT, DELETE, UPDATE) and incapable of returning the result.
Alternatively, you can use a Recordset with your SQL query to fetch what you want, but thats more work and the DLookup is designed to exactly avoid doing that for single column return selects.

How to execute an SQL statement in VBA using " sign to Get the ID with RecordSet Access 2013

I am looking to execute the following code, the problem is, I need to put a String variable in the SQL which should use the "" sign inside the SQL statement.
The problem is, I cannot use multiple "". I tried using Char to use the sign " and convert it to a String, and that's when I got lost.
The code below shows 2 Functions. 1 To see if I get it right to print the correct SQL statement, the other is a Function to return the actual record ID which I will then use to add a new record.
What I mainly looking to do, is use the RecordSet to get a record ID of one of the records.
Any help would be highly appreciated.
Private Sub PrintSQLStatement_Click()
Dim strSQL As String
Dim strTmp As String
Dim i As Integer
strTmp = "UE243"
strSQL = "SELECT tbl_Sales.[ID], tbl_Sales.[SaleReference] FROM tbl_Sales WHERE (((tbl_Sales.[SaleReference])= "" + strTmp + ""));"
i = MsgBox(strSQL, vbOKOnly)
End Sub
Private Function GetSaleID(ByVal strSaleRef As String) As Integer
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim ID As Integer
strSQL = "SELECT tbl_Sales.[ID], tbl_Sales.[SaleReference] FROM tbl_Sales WHERE (((tbl_Sales.[SaleReference])= "" + strSaleRef + ""));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
ID = rs.GetID
rs.Close
Set rs = Nothing
db.Close
GetSaleID = ID
End Function
You can avoid character escaping issues by using a QueryDef object to run a parameterized query like so:
Private Function GetSaleID(ByVal strSaleRef As String) As Long
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
Dim ID As Long
strSQL = _
"PARAMETERS prmSaleRef TEXT(255);" & _
"SELECT tbl_Sales.[ID] FROM tbl_Sales " & _
"WHERE tbl_Sales.[SaleReference]=[prmSaleRef]"
Set db = CurrentDb
Set qd = db.CreateQueryDef("", strSQL)
qd!prmSaleRef = strSaleRef
Set rs = qd.OpenRecordset(dbOpenSnapshot)
ID = rs!ID
rs.Close
Set rs = Nothing
Set qd = Nothing
db.Close
Set db = Nothing
GetSaleID = ID
End Function

Data on disk is not directly updated with the 'Update' functionality on my recordset

I am working on some VBA macros. I also use ADODB.Recordset to access data in my Access database.
Now, I need to loop through records in my table and in this loop, also need to update the same table in another function.
Here is the code (cleaned for easy reading).
Dim strSql As String
Dim rstCycles As adodb.Recordset
strSql = "SELECT * FROM tblCycles WHERE DatePlanning = #" & dteCurrentDate & "#"
Set rstCycles = SelectQuery(strSql)
While Not rstCycles.EOF
if ... then
rstCycles("NoCycle1") = ...
rstCycles.Update
end if
RefreshPlanning (*)
rstCycles.MoveNext
Wend
(*) In this function I perform a select on the tblCycles table.
The problem is after the rstCycles.Update, the data is not immediately record on disk thus the call to RefreshPlanning does not read updated data. If I set a '1 second pause' after the update everything is ok. I don't want to use a kind of pause in my loop. Is there another solution?
UPDATE ---------------
RefreshPlanning is a simple function to refresh my excel sheet based on my tblCycles table.
Sub RefreshPlanning(DatePlanning As Date, CodeEquipement As String)
Dim strSql As String
Dim rstCycles As adodb.Recordset
strSql = "SELECT * FROM tblCycles WHERE DatePlanning = #" & DatePlanning & "# AND CodeEquipement = '" & CodeEquipement & "'"
Set rstCycles = SelectQuery(strSql)
While Not rstCycles.EOF
' Some code here to update my excel sheet
' ...
rstCycles.MoveNext
Wend
End Sub
DAO is many times faster than ADO with MS Access:
Dim strSql As String
Dim rstCycles As DAO.Recordset
Dim db As Database
Set db = OpenDatabase("z:\docs\test.accdb")
strSql = "SELECT * FROM tblCycles WHERE DatePlanning = #" & dteCurrentDate & "#"
Set rstCycles = db.OpenRecordset(strSql)
While Not rstCycles.EOF
if ... then
rstCycles.Edit
rstCycles("NoCycle1") = ...
rstCycles.Update
end if
''Need more information here
RefreshPlanning (*)
rstCycles.MoveNext
Wend
If dteCurrentDate is the same as today, you can say:
"SELECT * FROM tblCycles WHERE DatePlanning = Date()"