I have been unable to find a solution to this problem, so I hope some of you may be of help. I'm trying to create an Audit Trail for an Access database to track changes. Many of my tables have composite primary keys (multiple fields combined to uniquely identify records). I obtained the following code for the Audit module:
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data. 'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
Select Case .ControlType
Case acTextBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'& cDQ & Environ("username") & cDQ & ", " _
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
Case acComboBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
'& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .NAME & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
Case acListBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
And then in the code for individual Forms I have the following code to run the module:
Option Compare Database
Private Sub Form_BeforeUpdate(Cancel As Integer)
Call AuditTrail(Me, HeaderID)
End Sub
I have found when I substitute the field name where HeaderID is for the name of a single valued primary key, the code works fine. When my table has multiple fields making up the primary key I am not sure how to format 'HeaderID' to recognize the composite of those values. I also have look up tables in some forms, but I'm unsure if that is contributing to the problem.
The error messages I'm getting:
Compile Error:
ByRef argument type mismatch
Any thoughts would be greatly appreciated!
Thank you,
Tiffany
Your AuditTrail subroutine takes as its parameters the form and the control where the edit to the data happens. So when you pass 'Me' and the name of the field (control), you're actually passing the current form and the control to the subroutine. When you change 'HeaderID' to anything other than a control name you will get the 'Type Mismatch' error because your subroutine is expecting a control and not a piece of data.
You will need to adjust your AuditTrail subroutine to take the index value that you actually want to store in your table. If your combined ID is a string made up of three values then change the parameter of the AuditTrail subroutine from 'control' to 'string'.
Related
I want to create a new table "TblMany", filtering values from other data table "TblControl".
Filtering with multiple checkboxes of a Form "FrmMany".
Table with data "TblControl":
Form with checkboxes, representing all values available in "Box?" columns from data table:
After pressing the button, it should create a new table (or recreate one existing) that shows rows with numbers selected in the "FrmMany"
Multiple selection needed:
I have done some tests with "iif" or "where" but i think it's only possible via VBA.
Any ideas?
You are correct that you will need to use VBA to do this. Firstly, you will need to loop the checkboxes to see if they are to be used in the selection of data. Once this has been done, you need to build a SQL string that inserts the data into the existing table. Something like this seems to work:
Private Sub cmdProcess_Click()
On Error GoTo E_Handle
Dim intLoop1 As Integer
Dim strSQL As String
For intLoop1 = 1 To 8
If Me("chk" & intLoop1) = True Then strSQL = strSQL & intLoop1 & ","
Next intLoop1
If Len(strSQL) > 0 Then
If Right(strSQL, 1) = "," Then strSQL = Left(strSQL, Len(strSQL) - 1)
CurrentDb.Execute "DELETE * FROM tblMany;"
CurrentDb.Execute "INSERT INTO tblMany " _
& " SELECT * FROM tblControl " _
& " WHERE Box1 IN(" & strSQL & ") " _
& " OR Box2 IN(" & strSQL & ") " _
& " OR Box3 IN(" & strSQL & ");"
End If
sExit:
On Error Resume Next
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "cmdProcess_Click", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
I am assuming that tblMany is an exact copy of of tblControl apart from field ID being an Autonumber in tblControl and just numeric in tblMany.
Rather than repeatedly deleting and inserting data (which will lead to bloat), you may find it better to use a query and modify its SQL as needed:
CurrentDb.QueryDefs("qryMany").SQL="SELECT * FROM tblControl " _
& " WHERE Box1 IN(" & strSQL & ") " _
& " OR Box2 IN(" & strSQL & ") " _
& " OR Box3 IN(" & strSQL & ");"
I am trying to create an update form. It is supposed to take values from the text boxes on the form and update that registry using the ID's autonumber as an identifier. It says I cannot edit the ID even though I don't think I am.
Private Sub edit_Click()
'Will edit the currently selected record
CurrentDb.Execute "UPDATE DataInput " & _
" SET ID=" & Me.txtID & _
", [Date]='" & Me.Date & "'" & _
", [Time Up]='" & Me.txttimeup & "'" & _
", [Notes]='" & Me.CboNotes & "'" & _
", [Time Down]='" & Me.txtTimeDown & "'" & _
" WHERE ID=" & Me.txtID.Tag
Me.txtID.Tag = ""
'refresh data on form
DataInput_subform.Form.Requery
'Disable Update Button
Me.edit.Enabled = False
'Enable Edit Button
Me.cmdEdit.Enabled = True
'Clear texts
cmdClear_Click
Try formatting your code in a more readable way and add a debug like
Dim sSql As String
sSql = "UPDATE DataInput SET [Date]=#" & Format(Me.Date,"mm/dd/yyyy") & "#, "
sSql = sSql & "[Time Up] = '" & Me.txttimeup & "', [Notes] ='" & Me.CboNotes & "', "
sSql = sSql & "[Time Down] = '" & Me.txtTimeDown & "' "
sSql = sSql & "WHERE ID = " & Me.txtID & " ;"
Debug.Print sSql
CurrentDb.Execute sSql
I'm using an UPDATE Statement but whenever I click the Edit button then Update, it's entering a new line but with the same data.
My code:
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtNumber.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO tblcompany (companyname, companyaddress, contactnumber, contactperson, emailaddress, website, plantlocation, projectinfo, consultant) " & _
" VALUES('" & Me.txtCompanyName & "','" & _
Me.txtCompanyAddress & "','" & Me.txtContactNumber & "','" & _
Me.txtContactPerson & "','" & Me.txtEmailAddress & "','" & _
Me.txtWebsite & "','" & Me.txtPlantLocation & "','" & _
Me.txtProjectInfo & "','" & Me.txtConsultant & "')"
Else
'otherwise (tag of txtNumber store the number of company to be modified)
CurrentDb.Execute "UPDATE tblcompany " & _
" SET companyname='" & Me.txtCompanyName & "''" & _
", companyaddress='" & Me.txtCompanyAddress & "''" & _
", contactnumber='" & Me.txtContactNumber & "'" & _
", contactperson='" & Me.txtContactPerson & "''" & _
", emailaddress='" & Me.txtEmailAddress & "'" & _
", website='" & Me.txtWebsite & "'" & _
", plantlocation='" & Me.txtPlantLocation & "''" & _
", projectinfo='" & Me.txtProjectInfo & "''" & _
", consultant='" & Me.txtConsultant & "''" & _
" WHERE number=" & Me.txtNumber.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
frmCompanySub.Form.Requery
End Sub
Isn't the Tag property empty by default? if you're saving a new record you will have to set a tag property equal to the number. So that when you come to update a record the Where number = & me.txt.number.tag is true. Otherwise all record tags of "" will equal "".
Also, tab in on your currentDb.execute line (after then).
Two part question:
I am trying to write a VBscript where a loop runs, but there is a message box that the user can use to abort the sequence at anytime. I know that if you have a sequence with msgbox in it, the script will stop executing until an answer has been received, but can I run it as a subscript, so it doesn't interfere with the main script?
when I use the following script, I never see the msgbox
function test()
msgbox ("test")
end function
wscript.sleep 1000
msgbox "done
i was under the impression that function let you get inputs. Can this even be done with pure vbscript?
Not what I was going for but this is a work around I found. It makes a temporary msgbox that closes itself after a time. Gives the user a 5 second window to abort the sequence each loop.
set infobox = createobject("Wscript.shell")
do while E<N+1
E=E+1
if InfoBox.Popup ("Click cancel to stop sequence", _
5, "Abort Sequence?", 1) = 2 then
E=N+1
end if
loop
The Trick here is to have the first script create and start a second script. This second script will just run in the background and can then wait and kill the initial script Process... This can easily be done with a Function and can be called at the start of your script. When your main script ends, it simply kills the previously created second script. Note: the second script which is created will automatically delete itself upon being run. See the below Script for a good working example:
Dim iKillPID
'Start Kill Script At Start Of Script
iKillPID = KillPID()
For X = 10 To 0 Step -1
WScript.Echo "Closing in " & X & " Seconds"
WScript.Sleep 1000
Next
'Kill The Kill Script At End Of Script
GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & iKillPID & "'").Terminate
MsgBox "This Script is Complete"
'$$$$$$$$$$
Function KillPID()
Dim strKillScriptPath, strKillCommand, KillFile, StrFileKill, iScriptPID
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
'Generates a Unique Temp File Name In The Same Directory As The Current Script
strKillScriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName) & Chr(92) & Replace(objFSO.GetTempName, ".tmp", ".vbs")
'Command Line To New Kill Script
strKillCommand = "WScript.exe " & Chr(34) & strKillScriptPath & Chr(34)
'This part gets the Process ID of the Current Running Script
iScriptPID = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & _
CreateObject("WScript.Shell").Exec("CMD /C ping 127.0.0.1 -n 2 > nul").ProcessID & "'").ParentProcessID
'String With Kill File Code (Script Process ID Included)
StrFileKill = _
"Const iKillProc = " & iScriptPID & vbCrLf & _
"Dim objFSO: Set objFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbCrLf & _
"objFSO.DeleteFile WScript.ScriptFullName, True" & vbCrLf & _ '<-- Deletes itself immediately upon running
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iKillProc & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If objKillProc Is Nothing Then" & vbCrLf & _
" MsgBox " & Chr(34) & "The Process Is Not Running" & Chr(34) & vbCrLf & _
" WScript.Quit" & vbCrLf & _
"End If" & vbCrLf & _
"MsgBox " & Chr(34) & "Click OK To Kill The Script Process" & Chr(34) & vbCrLf & _
"Call KillProcess(iKillProc)" & vbCrLf & _
"WScript.Quit" & vbCrLf & _
"Sub KillProcess(iProcID)" & vbCrLf & _
"Dim objKillProc, strParentProc" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iProcID & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If Err = 0 And Not objKillProc Is Nothing Then" & vbCrLf & _
" If StrComp(objKillProc.Name, " & Chr(34) & "cmd.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
" StrComp(objKillProc.Name, " & Chr(34) & "cscript.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
" StrComp(objKillProc.Name, " & Chr(34) & "wscript.exe" & Chr(34) & ", 1) = 0 Then" & vbCrLf & _
" strParentProc = objKillProc.ParentProcessID" & vbCrLf & _
" objKillProc.Terminate()" & vbCrLf & _
" Call KillProcess(strParentProc)" & vbCrLf & _
" End If" & vbCrLf & _
"End If" & vbCrLf & _
"Set strParentProc = Nothing" & vbCrLf & _
"Err.Clear" & vbCrLf & _
"End Sub"
'Write the Code To File
Set KillFile = objFSO.CreateTextFile(strKillScriptPath, True)
KillFile.WriteLine StrFileKill
KillFile.Close
Set KillFile = Nothing
WScript.Sleep 250
'Execute The Script and Return the Script Process ID So You Can Kill It When The Script Ends
KillPID = CreateObject("WScript.Shell").Exec(strKillCommand).ProcessID
End Function
'$$$$$$$$$$
Also, If you're using CScript as the Scripting Engine for your VBS, I believe you can stop the script by pressing CTRL + C in the Command Prompt Window.
Now if your super motivated you can create an HTA that does about the same thing, but present a UserForm or Custom Internet Explorer Window to click and it can also loop through and check if the process is still running and close itself when the script is finished and the process is no longer running. You can add pretty colors and everything too!
I have created a form with submit buttons on it.
I have entered the data in the text box and then clicked on submit button.But the data is not getting saved in the table.Also,it is not showing any error message. It is not working at all.
Private Sub CmdAddNew_Click()
'add data to table
CurrentDb.Execute "INSERT INTO tblemployee(firstname,lastname,Address,city)" & _
" VALUES('" & Me.txtfirstname & "','" & Me.txtlastname & "','" & Me.txtaddress & "','" & Me.txtcity & "')"
try this:
Private Sub CmdAddNew_Click()
Dim dbs As DAO.Database, Sqltext As String, iCount As Integer
Set dbs = CurrentDb
Sqltext = "INSERT INTO tblemployee(firstname,lastname,Address,city) " & _
"VALUES('" & Me.txtfirstname & "','" & Me.txtlastname & _
"','" & Me.txtaddress & "','" & Me.txtcity & "');"
Debug.Print "SQL statement generated with variables:" & vbCrLf & Sqltext
dbs.Execute Sqltext, dbFailOnError
iCount = dbs.RecordsAffected
Debug.Print "..." & iCount & " row(s) inserted"
End Sub
The debug.print messages will print to the immediate window (Ctrl+g) to view from VBA editor, you can delete them if you want to once you have confirmed it's working.