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
Related
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
I am creating a new query in MS Access that updates an existing record based on the "Branch" and "Employee" fields. How can I set the criteria to reference cell values? Say A2 holds the "Branch" ID for Access and B2 holds the value for the "Employee" ID in Access.I want to update my Access "Notes" Field. My query works when running in Excel, but only because I have specified what the "Employee" & "Branch" ID's are. Nothing updates when i run my code below:
Code
Sub modify_record()
Dim ac As Object
Dim branchid As String
Dim employeeid As String
Dim notesF As String
Set ac = CreateObject("Access.Application")
branchid = Sheets("Sheet4").Range("A2")
employeeid = Sheets("Sheet4").Range("B2")
notesF = Sheets("Sheet4").Range("C2")
Dim strDatabasePath As String
strDatabasePath = "C:\Users\johnsmith\OneDrive\pbsbackup.mdb"
With ac
.OpenCurrentDatabase (strDatabasePath)
Dim db As Object
Set db = .CurrentDb
db.Execute "Update_Records"
End With
End Sub
Query in MS Access. Saved as Update_Records
UPDATE pbsmaster SET pbsmaster.notes = "notesF" WHERE
(((pbsmaster.branch)="branchid") AND((pbsmaster.employee)="employeeid"));
Your variables don't magically transfer into the query, just because they have the same name.
You need to specify the parameters in the Access query, and pass them via a DAO.QueryDef object in the Excel VBA code.
Here is an example: https://stackoverflow.com/a/2317225/3820271
Dim qd As Object ' DAO.QueryDef
Set qd = db.QueryDefs("Update_Records")
qd.Parameters("branchid") = branchid
' etc.
qd.Execute
Here is my solution from what I learned from #Andre. I am able to execute my code, I noticed working with Parameters is much quicker than opening a recordset with DAO.
Sub foo()
Dim db As Database
Dim qdf As QueryDef
Set db = OpenDatabase("C:\Users\employee\OneDrive\samplefile.mdb")
Set qdf = db.CreateQueryDef("", _
"PARAMETERS pbsbranch text , pbsnotes text; " & _
"UPDATE pbsmaster SET pbsmaster.notes=[pbsnotes] " & _
"WHERE pbsmaster.branch=[pbsbranch] " & _
"")
qdf!pbsbranch = Sheets("Sheet4").Range("A2")
qdf!pbsnotes = Sheets("Sheet4").Range("C2")
qdf.Execute dbFailOnError
Set qdf = Nothing
Set cdb = Nothing
End Sub
Currently I have the following code that allows me to insert values into specific fields in QuickBooks.
I am trying to add fields from a table into QuickBooks row by row:
See picture ex:
Example:
At the end of each row there is a column for sending off the entries to QuickBooks. How can I modify my code to have this function work?
Public Sub exampleInsert()
Const adOpenStatic = 3
Const adLockOptimistic = 3
Dim oConnection
Dim oRecordset
Dim sMsg
Dim sConnectString
Dim sSQL
sConnectString = "DSN=Quickbooks Data;OLE DB Services=-2;"
sSQL = "Insert into customer (Name, FullName, CompanyName) values ('Testing VB', 'Full Name', 'Test Company Name')"
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
oConnection.Open sConnectString
oConnection.Execute (sSQL)
sMsg = sMsg & "Record Added"
MsgBox sMsg
Set oRecordset = Nothing
Set oConnection = Nothing
End Sub
UPDATE:
I added:
sConnectString = "DSN=Quickbooks Data;OLE DB Services=-2;"
sSQL = "Insert into customer (Name, CompanyName) Select Num, Description From TestTable"
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
oConnection.Open sConnectString
oConnection.Execute (sSQL)
sMsg = sMsg & "Record Added"
MsgBox sMsg
But I get the error "Invalid table name: TestTable" how can I get this SQL script to see my Access table?
To add the form's current record values to your queries, you just pull the value (e.g. Me.txtDescription). I would recommend you use the ADODB.Command object, so you can parameterize your SQL and avoid SQL injection:
Option Explicit
Const adOpenStatic As Integer = 3
Const adLockOptimistic As Integer = 3
Const CONNECTION_STRING As String = "DSN=Quickbooks Data;OLE DB Services=-2;"
Private Sub Command10_Click()
Dim cn As ADODB.Connection
Dim cmd As ADODB.Command
Dim param As ADODB.Parameter
Dim sMsg As String
' set up ADODOB connection
Set cn = New ADODB.Connection
cn.Open CONNECTION_STRING
' set up ADODB command object
Set cmd = New ADODB.Command
cmd.ActiveConnection = cn
' note that we're using unnamed parameters,
' with the ? symbol
cmd.CommandText = _
"INSERT INTO customer " & _
"(Name, CompanyName) " & _
"VALUES " & _
"(?, ?)"
' add form values as command parameters
cmd.Parameters.Append cmd.CreateParameter( _
Type:=adVarChar, _
Size:=255, _
value:=Me.txtNumber)
cmd.Parameters.Append cmd.CreateParameter( _
Type:=adVarChar, _
Size:=255, _
value:=Me.txtDescription)
' now that we have the command set up with its params,
' we can just execute it:
cmd.Execute
sMsg = "Record Added"
MsgBox sMsg
Set param = Nothing
Set cmd = Nothing
cn.Close: Set cn = Nothing
End Sub
Of course, you'll have to use the actual names of your textboxes.
Also, please notice a couple of additional modifications I a made to your original code:
I have Option Explicit defined. You may already have this in your code, but if not, you need it. That way, any variables used have to be declared. For more information, see the Microsoft Docs
I moved your ADODB constants outside your sub. Ideally, you'd either use early binding and add the ADODB library reference (so you don't need to define these yourself), or add them in a separate module, so you can use them in any of your forms.
I also added your connection string as a constant outside your sub. Again, this should probably be in a separate module (e.g. modConstants) you can easily refer to from anywhere in your project.
I improved the indentation of your code.
I explicitly added the types for your declarations (Dim sSQL as String rather than just Dim sSQL). Note that if you declare a variable without a type, it defaults to the Variant type, instead of String (which you want). See Microsoft Docs for more information.
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.
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