I have a Access 2010 Database using a multivalued field (the Access inbuilt way to have m:n-relation between two tables).
To keep track of changes to the database I use an AuditTrail VBA procedure every time the corresponding form is updated, saving all the changes to history table.
Now, when I change the value of the ComboBox and the loop reaches the ComboBox bound to the multivalued field, the procedure throws an error because of incompatible Data types:
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "History" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![timestamp] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![recordid] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![beforeValue] = ctl.OldValue
![afterValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
How do I get the actual Value and the OldValue from a combobox converted to string in VBA?
I tried combobox.focus and then combobox.Text
This works, but doesnt help with the OldValue problem.
How to properly use the value and oldvalue property of comboboxes? The official VBA object reference for comboboxes doesn't help at all.
https://msdn.microsoft.com/en-us/library/office/ff821691.aspx
When ctl references a multi-valued combo box with at least one item selected, your test condition ...
Nz(ctl.Value) <> Nz(ctl.OldValue)
... will certainly throw a type mismatch error. In that situation, ctl.Value is actually a variant array, and Nz() can't cope with it. The problem is essentially the same as this ...
Debug.Print Nz(Array(1,2,3)) '<- type mismatch error
Perhaps you would prefer to grab a string of the concatenated combo selections ...
Debug.Print Join(ctl.Value, ",")
If that seems useful, beware that ctl.Value will be Null when none of its items is selected. And attempting to Join() Null will also trigger type mismatch error.
Note those issues also apply to ctl.OldValue.
But there may be yet another complication. Based on my testing I'm skeptical whether OldValue is reliable for a multi-valued combo box. If you also find that to be the case, use the form's current event to store the combo's initial selections in a form level variable and reference that variable (instead of OldValue) in your audit procedure.
It is not an elegant solution, only a quick & dirty workaround:
Modify your code so that it checks differently ComboBox1 and the other controls.
The .Value and .OldValue are basically an array of variants.
Dim afterValue as variant
Dim beforeValue as Variant
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "History" Then
If Ctl.name = "ComboBox1" then
err.clear
on error resume next
I=0
afterValue = ""
beforeValue = ""
while err=0
'
' Throws an error if 'out of range', i.e. after the last value
'
afterValue = afterValue + Nz(Cstr(ComboBox1.Value(I))) + ";"
beforeValue = beforeValue + Nz(Cstr(ComboBox1.OldValue(I))) + ";"
wend
else
afterValue = ctl.Value
beforeValue = Nz(ctl.OldValue)
endif
If Nz(ctl.Value) <> a$ Then
With rst
.AddNew
![timestamp] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![recordid] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![beforeValue] = beforeValue
![afterValue] = afterValue
.Update
End With
End If
End If
Next ctl
Related
I am trying to write some code to audit changes made via a form. I have a function that works to do this:
Function WriteChanges()
Dim f As Form
Dim c As Control
Dim user As String
Dim db As DAO.Database
Dim cnn As ADODB.Connection
Dim MySet As ADODB.Recordset
Dim tbld As TableDef
Dim recsource As String
Set f = Screen.ActiveForm
Set db = CurrentDb
Set cnn = CurrentProject.Connection
Set MySet = New ADODB.Recordset
recsource = f.RecordSource
Set tbld = db.TableDefs(recsource)
pri_key = fFindPrimaryKeyFields(tbld)
Debug.Print "pri_key: "; pri_key
user = Environ("username")
MySet.Open "Audit", cnn, adOpenDynamic, adLockOptimistic, adCmdTable
For Each c In f.Controls
Select Case c.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup
If c.Value <> c.OldValue Then
With MySet
.AddNew
![EditDate] = Now
![user] = user
![SourceTable] = f.RecordSource
![SourceField] = c.ControlSource
![BeforeValue] = c.OldValue
![AfterValue] = c.Value
.update
End With
End If
End Select
Next c
MySet.Close
Set MySet = Nothing
Set f = Nothing
Set db = Nothing
End Function
I use this function on the before update property of various forms and it populates the Audit table with the details of the changes to values in each of the controls. I need to also get the value from the primary key field to add to the Audit table. I can use the following code to identify the name of the primary key within the form's record source:
Function fFindPrimaryKeyFields(tdf As TableDef) As String
Dim idx As Index
On Error GoTo HandleIt
For Each idx In tdf.Indexes
If idx.Primary Then
fFindPrimaryKeyFields = Replace(idx.Fields, "+", "")
GoTo OutHere
End If
Next idx
OutHere:
Set idx = Nothing
Exit Function
HandleIt:
Select Case Err
Case 0
Resume Next
Case Else
Beep
MsgBox Err & " " & Err.Description, vbCritical + vbOKOnly, "Error"
fFindPrimaryKeyFields = vbNullString
Resume OutHere
End Select
End Function
How can I use this to get the value from the control (text box) that has the identified primary key as its control source.
Please forgive any silly errors in my code as I'm a relative novice. Thanks in advance for any help.
I'm not 100% sure what you want exactly, but if you have the name of the field, you can use the following:
Dim primaryKeyValue As Variant
Dim primaryKeyColumnName As String
primaryKeyColumnName = fFindPrimaryKeyFields(TableDefs!MyTable)
Dim f as Form
'Get the form somehow
Dim c As Control
On Error GoTo NextC 'Escape errors because lots of controls don't have a control source
For Each c In f.Controls
If c.ControlSource = primaryKeyColumnName Then
primaryKeyValue = c.Value
End If
NextC:
Next c
On Error GoTo 0
If the primary key column is part of the form record source, you can simply read it by:
Debug.Print "PK value: " & f(pri_key)
Every column of the record source is a form property at runtime, independent of whether there is a control with the same name.
Note: your whole construct will stop working if you have a form that is based on a query that joins multiple tables.
I am trying to track value changes when editing a record. All fields on the form are unbound text box.
Below is a function that is used to insert a audit tracking record.
Public Function AuditChanges(RecordID As String, UserAction As String)
Dim DB As Database
Dim rst As Recordset
Dim clt As Control
Dim Userlogin As String
Set DB = CurrentDb
Set rst = DB.OpenRecordset("select * from tbl_audittrail", adOpenDynamic)
Userlogin = Environ("username")
Select Case UserAction
Case "Edit"
For Each clt In Screen.ActiveForm.Controls
If (clt.ControlType = acTextBox _
Or clt.ControlType = accombox) Then
If Nz(clt.Value) <> Nz(clt.OldValue) Then
With rst
.AddNew
![DateTime] = Now()
!UserName = Userlogin
!FormName = Screen.ActiveForm.Name
!Action = UserAction
!RecordID = Screen.ActiveForm.Controls(RecordID).Value
!FieldName = clt.ControlSource
!OldValue = clt.OldValue
!Newvalue = clt.Value
.Update
End With
End If
End If
Next clt
End Select
rst.Close
DB.Close
Set rst = Nothing
Set DB = Nothing
End Function
Below is how I use the function:
Private Sub btnUpdate_Click()
Set DB = CurrentDb
Set rs = DB.OpenRecordset("SELECT * FROM ASID", dbOpenDynaset, dbSeeChanges)
rs.Edit
rs!ISIN = Me.ISIN
rs!SECIDTYPE = Me.SECIDTYPE
rs!ALTSECID = Me.ALTSECID
rs.Update
Call AuditChanges("ISIN", "Edit")
End If
End Sub
The problem is when it calls AuditChanges, it goes directly from
If (clt.ControlType = acTextBox _
Or clt.ControlType = accombox)
to End If
All fields on current form are unbound text boxes and you have to press an "Add" command button to actually add a record. I think there must be something wrong with the control type but I am not sure which control type should be used. Any idea?
Start by putting Option Explicit at the top of each module.
It enforces variable declaration and reports undeclared or misspelled variables/constants at compile time.
To have this automatically in new modules, set the Require Variable Declaration option in the VBA Editor.
This is really a must have for VBA development.
Then the compiler will tell you that accombox doesn't exist, it should be acComboBox
Without Option Explicit, accombox is initialized as NULL variant, and causes your entire If condition to be NULL, and therefore never be entered.
I am currently working on adding an audit trail to a MS-Access 2010 database and I am struggling with
"error 3251 : operation is not supported for this type object"
Here is the code of my audit trail module, mostly arranged code coming from web :
Public Function auditChanges(RecordID As String, userAction As String, cForm As Form)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim ctl As Control
Dim userLogin As String
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM T_AUDIT")
userLogin = getCurrentUser
Select Case userAction
Case "New"
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
.Update
End With
Case "Delete"
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
.Update
End With
Case "Edit"
For Each ctl In cForm.Controls
If (ctl.ControlType = acTextBox) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acCheckBox) Then
If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
![champs] = ctl.ControlSource
![ancienneValeur] = ctl.OldValue
![nouvelleValeur] = ctl.Value
.Update
End With
End If
End If
Next ctl
End Select
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
End Function
This function is called in beforeUpdate event of the forms I want to track.
The error is fired when I try to edit a bound textbox. And the line If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then is the line provoking the error
The form is based on 2 tables linked with a One-To-Many relationship. The function is working when I edit fields from the table which are sided to the "One" part of the relationship but it throws the error when I want to edit fields from the "Many" side.
I hope I am clear enough, thank you
Edit : More details
My form is based on that request :
SELECT T_REVISION.ID_revision, T_REVISION.fk_ID_proposition, T_REVISION.numero, T_REVISION.fk_etat_revision, T_REVISION.EOTP, T_PROPOSITION.reference_simple, T_PROPOSITION.libelle, T_REVISION.description_localisation
FROM T_PROPOSITION INNER JOIN T_REVISION ON T_PROPOSITION.ID_proposition = T_REVISION.fk_ID_proposition
ORDER BY T_REVISION.numero DESC;
The error is fired from T_PROPOSITION.reference_simple control.
The error 3251 occurs when : I try to edit T_REVISION.EOTP, T_REVISION.description_localisation fields. The error 3251 does not occur when I edit T_PROPOSITION.reference_simple, T_PROPOSITION.libelle !
So : I'am able to edit values coming from the "One" side of the relation but when I want to edit the "Many" side it seems I can't access the oldValue property
How can I solve this ?
Not exactly an answer, but the comment area is not suitable...
If would add 2 lines BEFORE the If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
:
debug.print ctl.Name, ctl.value
debug.print ctl.name, ctl.oldvalue
This will allow you to see if the error is linked to a specific control and to a specific property, and narrow your search.
Edit: After you edited your OP indicating that the issue arises on the "many" side of you join, I think you should change your form to a "main form - subform" architecture. This will allow you to track updates to each TABLE correctly.
It's hard to tell exactly what's causing the error when you don't specify the line that's popping up the error, but there is one obvious possibility.
You're trapping for Null in your control loop
If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
And more importantly you're missing a front parentheses as " ("
But then you don't trap for that possibility when assigning the control's value and old value to your recordset.
![ancienneValeur] = ctl.OldValue
![nouvelleValeur] = ctl.Value
Do your fields ancienneValeur and nouvelleValeur allow for null or zero length fields to be assigned to them?
In any case you should be consistent and make sure you trap for null values before assigning them to your table's fields.
![ancienneValeur] = NZ(ctl.OldValue,"")
![nouvelleValeur] = NZ(ctl.Value,"")
I have a number of datasheets that get used in subforms throughout my Access program. It is nice to be able to sometimes adjust the name slightly of the headers on these datasheets and then have this translate across my whole program. To do that I thought I would have a list of column names in a table (in MS SQL Server), with their aliases next to them in a second column. I use the column names as the control sources and the aliases as the names:
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim controlName As String
Set dbs = CurrentDb
For Each ctl In Me.Controls
If ctl.Name <> "Student ID" And ctl.Name <> "NameField" And ctl.Name <> "Preferred Name" And ctl.Name <> "Course" And ctl.Name <> "Class" And ctl.Name <> "Current" _
And ctl.Name <> "leftCourseFor" And ctl.Name <> "cancelled" And ctl.Name <> "termID" And TypeOf ctl Is TextBox Then
strSQL = "Select aliasedName From dbo_assessmentNameAliases Where course = '" & courseString_glb & "'" _
& " And assessmentColumnName = '" & ctl.ControlSource & "'"
Set rs = dbs.OpenRecordset(strSQL)
rs.MoveFirst
controlName = rs!aliasedName
ctl.Name = controlName
End If
Next
rs.Close
dbs.Close
Set rs = Nothing
Set dbs = Nothing
However, I get the following error:
Microsoft Access can't add, rename, or delete the control(s) you requested.
How do I get around this?
You can do it. I found this code:
http://gainingaccess.net/Articles/RenameFormControls.aspx
I implemented it in Access 2013 and it worked perfectly. The trick is to instantiate the form without showing it, rename the controls, then deallocate the instance. Changes made to the form design will persist.
You can only change Name in design view, but you can set the Caption:
controlName = rs!aliasedName
ctl.Properties("DatasheetCaption").Value = controlName
I am working on a function for my access database that fills in a form field in my task form automatically based on the data entered in products forms.
Function IsProductReceived(varID As Variant) As String
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim lngTOID As Long
Dim strReceiveDate As Date
Dim bAcceptable As Boolean
On Error GoTo ErrorHandler
If IsNull(varID) Then
IsProductReceived = "TBD"
Else
lngTOID = varID
strSQL = "SELECT tblProduct.TaskID, tblProduct.Received, tblProduct.Acceptable FROM tblProduct WHERE tblProduct.TaskID = " & lngTOID
rst.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If rst.BOF And rst.EOF Then
IsProductReceived = "TBD"
Exit Function
Else
While rst.EOF = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "YES/ACCEPTED"
End If
Else
IsProductReceived = "NO"
End If
Else
IsProductReceived = "NO"
End If
rst.MoveNext
Wend
End If
rst.Close
Set rst = Nothing
End If
Exit Function
ErrorHandler:
MsgBox Err.Description
Err.Clear
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If
End Function
There is often more that one product forms related to the task form and products are received at different times. I want the "IsProductReceived = "no" to remain on the task form until ALL products related to the task are received.
This code seems to be working as long as the first product has not been received. I can seem to figure out how to make it remain "no" until all products are received.
I currently am using a while/wend, I have attempted a Do/loop but am still not having satisfactory results. Any help would be much appreciated
How about:
Function IsProductReceived(TaskID) As String
Dim product As New ADODB.Recordset
Dim sql As String
Dim countAll As Integer
Dim countReceived As Integer
Dim countAccepted As Integer
IsProductReceived = "TBD"
If Not IsNumeric(TaskID) Then Exit Function
sql = "SELECT Received, Acceptable FROM tblProduct WHERE TaskID = " & TaskID
product.Open sql, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
While Not product.EOF
countAll = countAll + 1
If IsDate(product!Received) Then countReceived = countReceived + 1
If product!Acceptable Then countAccepted = countAccepted + 1
product.MoveNext
Wend
product.Close
If countAll = 0 Then
IsProductReceived = "No"
ElseIf countAll = countAccepted Then
IsProductReceived = "YES/ACCEPTED"
ElseIf countAll = countReceived Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "No"
End If
End Function
A few notes:
Indent your code better.
Drop the faux Hungarian notation, use descriptive variable names.
Avoid deep nesting, especially when it comes to determining the return value.
Check parameters and exit early if the check fails. This removes nesting depth from the function.
Avoid Variant parameter types unless the function must deal with different data types. Here an Integer or Long type would probably be a better fit. (Using a typed function parameter removes the need for a type check entirely.)
While x = False is an antipattern. Use While Not x.
No need to save recordset fields in local variables first. Just use them directly.
Avoid building SQL from string concatenation. After an IsNumeric() check the above is probably okay, but you really should use parameterized queries.
The issue I'm seeing with your code is that you're getting a record set from a table, looping through the set and testing "Recieved" and then assigning a return value for your function after each test. Effectively, you're just returning the value of the very last record in the recordset. Perhaps instead of setting the value of isProductRecieved inside the While loop, set a bool value to false whenever you encounter a product that hasn't been recieved and then set the return value of the function after the loop:
Dim receive As Boolean
Dim accept As Boolean
receive = True
accept = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
accept = False
Else
accept = True
End If
Else
receive = False
End If
Else
receive = False
End If
So now, if "receive" makes it all the way to the end of your while loop, you know that each product is received but if any product was not received it would be set to false. You could also build a short circuit in there to make it a tiny bit faster.