I have tried to create the event procedure, but It returns zero irrespective of my selection.
I have two tables, which are correctly joined, and below is the code that has an issue.
First, "MsgBox Me.Technology" is returning my selection value eg. Python, Java, but "MsgBox rs!ProjEmployeeID" is returning 0 all times. Help me troubleshoot the code. Thank you. I want it to return Project Employee ID like 1, 2, 3
Option Compare Database
Private Sub Technology_AfterUpdate()
MsgBox Me.Technology
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ProjEmployeeID FROM Project WHERE Technologies = Trim('" & Forms!Form_employee_by_technologies!Technology & "')")
rs.AddNew
MsgBox rs!ProjEmployeeID
Dim strDocName As String
Dim strWhere As String
strDocName = "Technology"
strWhere = "[EmployeeID] =" & rs!ProjEmployeeID
DoCmd.OpenReport strDocName, acViewReport, , strWhere, acWindowNormal
End Sub
Related
I found this code on-line(http://www.fontstuff.com/access/acctut21.htm) to capture changes made to tables. The code works on the example database that was provided, but does not work on my database. For both the example and my database, changes are made through forms and triggered by an event procedure in the form properties at "Before Update". I do not get any errors, but nothing is written to the audit table. One difference between my form and that in the example is my form pulls data from multiple tables through a query, and updates are done to multiple tables. The example form is only showing fields from one table and updates are done only to one table.
How can I get this code to record my changes?
Option Compare Database
Option Explicit
Sub AuditChanges(IDField As String)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "Audit" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.NAME
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub
This is the code I use to create an audit log. It works well and can assign ItemTypes to the log entries. This is useful for viewing individual entries relating to a specific itemtype (such as Order, Customer, StockItem etc).
It is called by:
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error Resume Next
AuditLog Me, "Order", Me.ID
End Sub
Function Code
Public Sub AuditLog(frm As Form, ItemType As String, ItemID As Integer, Optional exControl As Variant)
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSql As String
On Error Resume Next
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Or acComboBox Or acCheckBox Then
If .Tag = 1 Then
Else
If IsOldValueAvailable(ctl) = True Then
If Nz(.Value, "[Empty]") <> Nz(.OldValue, "[Empty]") Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
strSql = "INSERT INTO [UserActivities] (UserID,Entry,[Field],OldValue,NewValue,Type,ItemID) " & _
"Values ('" & userid & "','Value Change','" & strControlName & "','" & varBefore & "','" & varAfter & "','" & ItemType & "','" & ItemID & "');"
CurrentDb.Execute strSql, dbFailOnError
End If
End If
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox err.Description & vbNewLine _
& err.Number, vbOKOnly, "Error"
End Sub
This question is basically the same as this other StackOverflow answer. I based our solution off the one in the link using parameters, and altered it to an ADO command instead. Using parameters and an ADO command allows you to exceed the 255 character limit with DAO parameters, and if you end up trying to track an RTF field, you won't have the headache of trying to parse HTML/markdown/whatever into a safe SQL String (and is also more resistant to SQL injection attacks if users enter such data into your form). You'll find I used a "longText" field for our old/new values as this facilitates using memo fields and a more reusable field.
Using an ADO command vs recordset is orders of magnitude faster when logging field changes, as you don't need to do anything except insert to the data.
Note the following:
This solution requires linked tables and fields. It does not handle detection for non-linked fields.
This solution ignores getting user details (username) in a safe manner. Using the Environ variable isn't super secure, but I left it.
I found caching the command for later makes the command run an order of magnitude faster vs building it each time. When you're logging all fields on a form routinely (eg, for auditing), this makes a big difference at not a lot of cost to memory or connections.
I assumed all the fields were "text". That's probably not the case, so you'll need to change your field types to match the correct types and sizes.
The Code:
Option Compare Database
Option Explicit
Private m_strUserID as String
Private m_StoredCMD as ADODB.Command
Private Property Get StrUserID as String
If m_struserID = vbNullString then m_strUserID = Environ("USERNAME")
StrUserID = m_struserID
End Property
Public Sub AuditChanges(ByRef FormToProcess as Access.Form, Byref RecordIDField as String)
Dim TimeStamp as DateTime
Dim CtrlCheck as Access.Control
Dim RecordIDFieldCtrl as Access.Control
Set RecordIDFieldCtrl = FormToProcess.Controls(RecordIDField)
TimeStamp = Now()
For Each CtrlCheck In FormToProcess
If IsChanged(CtrlCheck) And CtrlCheck.Tag = "Audit" Then
AddLogEntry (CtrlChanged, RecordIDFieldCtrl.Value)
End If
Next CtrlCheck
End Sub
Private Sub AddLogEntry (ByRef CtrlChanged as Control, ByRef RecordIDFieldCtrl as Access.Control)
Dim TimeStamp as DateTime
Dim adoCMD = ADODB.Command
TimeStamp = Now()
If IsChanged(CtrlChanged) Then ' Verify anything actually changed. Check twice because it doesn't cost anything.
Set adoCMD = GetLogCommand ' Note, it will be much faster to put this into a module stored command, but
With If adoCMD
(.ActiveConnection.State And adStateOpen) <> adStateOpen Then .ActiveConnection.Open
.Parameters("[pDateTime]") = TimeStamp
.Parameters("[pUserName]") = StrUserID
.Parameters("[pFormName]") = CtrlChanged.Parent.Name
.Parameters("[pRecordID]") = RecordIDFieldCtrl.Value
.Parameters("[pFieldName]") = CtrlChanged.Name
.Parameters("[pNewValue]") = CtrlChanged.Value
.Parameters("[pOldValue]") = CtrlChanged.OldValue
.Execute
End If
End Sub
Public Function GetLogCommand() As ADODB.Command
Dim cnn as ADODB.Connection
Dim SQLCommand as String
If m_StoredCMD Is Nothing Then
' Note: Verify these field type assumptions are correct and alter as needed.
' Note2: I use "LongText" Fields for values, because Access's VarChar Fields are limited to 255 charachters.
' If you're using any
SQLCommand = "PARAMETERS [pDateTime] DateTime, [pUserName] VARCHAR(255), " & _
"[pFormName] VARCHAR(255), [pRecordID] VARCHAR(255), [pFieldName] VARCHAR(255)," & _
"[pOldValue] LONGTEXT, [pNewValue] LONGTEXT;
INSERT INTO tblAuditTrail (DateTime,UserName,FormName,RecordID,FieldName,OldValue,NewValue) " & _
"VALUES ([pDateTime], [pUserName], [pFormName], [pRecordID], [pFieldName], [pOldValue], [pNewValue]); "
Set m_StoredCMD = New ADODB.Command
With m_StoredCMD
Set .ActiveConnection = CurrentProject.Connection
.CommandText = SQLString.GetStr
.CommandType = adCmdText
.Prepared = True
.Parameters.Append .CreateParameter("[pDateTime]", adDBTimeStamp, adParamInput, 255)
.Parameters.Append .CreateParameter("[pUserName]", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("[pFormName]", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("[pRecordID]", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("[pFieldName]", adVarChar, adParamInput, 255)
.Parameters.Append .CreateParameter("[pNewValue]", adLongVarChar, adParamInput, 63999)
.Parameters.Append .CreateParameter("[pOldValue]", adLongVarChar, adParamInput, 63999)
End With
End If
Set GetLogCommand = m_StoredCMD
End Function
Public Function IsChanged(ByRef CtrlChanged as Control) As Boolean
' There are a lot of ways to do this, but this keeps code clutter down, and lets you
' alter how you determine if a control was altered or not.
' As this is written, it will ONLY work on bound controls in bound forms.
IsChanged = ((CtrlChanged.OldValue <> CtrlChanged.Value) Or (IsNull(CtrlChanged.OldValue) = Not IsNull(CtrlChanged.Value)))
End Function
Let's say I have an hundred page report in Access 2010 that includes lists of names (with some other details), grouped by a variable called NOM_RITIRO.
I would like to output the report into different PDF files, one for each value of the variable used for grouping.
I was trying to figure out how to make this code work:
Sub SplitPdf()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Source As String
Dim SQL As String
Dim MyPath As String
Dim MyFilename As String
MyPath = "D:\Folder\"
Set db = CurrentDb
SQL = "Select NOM_RITIRO From QueryNominativi Group By NOM_RITIRO"
Set rs = db.OpenRecordset(SQL)
While Not rs.EOF
MyFilename = "TK_" & rs!NOM_RITIRO & ".pdf"
' Apply quotes as NOM_RITIRO is a string.
DoCmd.OpenReport "ElenchiNominativi", acViewPreview, , "NOM_RITIRO = '" & rs!NOM_RITIRO.Value & "'"
DoCmd.OutputTo acOutputReport, , acFormatPDF, MyPath & MyFilename, False
DoCmd.Close acReport, "ElenchiNominativi"
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
I got stuck when I try to run the DoCmd.OpenReport.
I get the message box "Enter parameter Value" like if the recordset is not passing any data
Any idea of what I did wrong?
If NOM_RITIRO is not a field in the recordsource of your report called "ElenchiNominativi" (or mis-spelled) then it will prompt you to enter a parameter value.
Similarly, if the recordsource of your report is a query that contains a fieldname not referenced in any of the tables, you will also get this prompt.
I am more or less a rookie in using VBA in Access and hope I'm not asking something stupid. Is it possible through VBA to run and save several queries that begin by the same word?
I have an Access file with multiple tables and queries, which are identified by an initial 3 digit code, eg 100QueryName. I am trying to only run the queries that begin with "901".
Hope someone can help me out.
Best regards
Jorge
The following code is a start (depending on what type of queries)...
Create a module and paste the following code. Then execute subroutine 'Test_it'
Option Compare Database
Option Explicit
Sub Test_it()
Dim strPrefix As String
' Ask user for query prefix
strPrefix = InputBox("Please enter query prefix", "Qry Prefix")
MsgBox "Executed " & Run_Queries(strPrefix) & " queries.", vbOKOnly, "COunt of Queries"
End Sub
Function Run_Queries(strPrefix As String) As Integer
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim strQryName As String
Dim iQryCt As Integer
Dim iQryRan As Integer
Dim i As Integer
Set dbs = CurrentDb
iQryCt = dbs.QueryDefs.Count
i = Len(strPrefix)
iQryRan = 0
For Each qdf In dbs.QueryDefs
strQryName = qdf.Name
Debug.Print strQryName
If LCase(left(strQryName, i)) = LCase(strPrefix) Then
Debug.Print " ** Run: " & strQryName & vbTab & qdf.Type
If qdf.Type = 0 Then ' Select query
' Open this query to view results
DoCmd.OpenQuery strQryName
ElseIf qdf.Type = 48 Then ' Update query
dbs.Execute strQryName
End If
iQryRan = iQryRan + 1
Else
End If
Next qdf
Set qdf = Nothing
Set dbs = Nothing
Run_Queries = iQryRan
End Function
I have a form (Cobind_frmMain) that allows the user to create a pool of titles that are attached to it. So there is a top level Pool Name (TopLvlPoolName) and on a subform, the titles are added to it. What I need is to issue a Report for each of the titles. I have the report and queries all set up. Right now, the report will show all the titles in one file. The titles are in a field called "CatCode".
What I need is the following:
1. Save each title as a PDF and save it to our server.
2. Open email and attach the PDF.
3. Repeat until all titles are done.
EDIT: This is what I have so far for code and the error message I still get is: "Too Few Parameters" on the Set Recordset line. I'm trying to set the parameter in the strSQL line. I want the PartPoolName (in Cobind_qryReport, a query) to equal the TopLvlPoolName on the open form. The SQL for Cobind_qryReport is listed below:
Private Sub btn_Run_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "Select * FROM Cobind_qryReport WHERE PartPoolName = " & Me.TopLvlPoolName
Set rs = db.OpenRecordset(strSQL)
On Error GoTo Err_PO_Click
If MsgBox("Do you wish to issue the cobind invites?", vbYesNo + vbQuestion, "Confirmation Required") = vbYes Then
rs.MoveFirst
Do While Recordset.EOF = False
DoCmd.OutputTo acOutputReport, "Cobind_rptMain", acFormatPDF, "K:\OB MS Admin\Postage\CoBind Opportunities\Sent Invites\" & [CatCode] & "_" & [PartPoolName] & "Cobind Invite_" & Format(Now(), "mmddyy") & ".pdf"
DoCmd.SendObject acSendReport, "Cobind_rptMain", acFormatPDF, , , , [CatCode] & "_" & [PartPoolName] & " Cobind Invite", "Please find the cobind invite attached. Response is needed by " & [RSVP] & ". Thank you.", True
Recordset.MoveNext
Loop
End If
Exit_PO_Click:
MsgBox ("It didn't work")
Exit Sub
Err_PO_Click:
MsgBox Err.Description
Resume Exit_PO_Click
End Sub
Cobind_qryReport SQL:
SELECT tblEvents.EventTitle, Cobind_tblPartic.CatCode, Cobind_tblPartic.CodeQty, Cobind_tblPartic.PartPoolName, Cobind_tblTopLvl.RSVP, Cobind_tblPartic.ID
FROM Cobind_tblTopLvl, Cobind_tblPartic INNER JOIN tblEvents ON Cobind_tblPartic.CatCode = tblEvents.EventCode
GROUP BY tblEvents.EventTitle, Cobind_tblPartic.CatCode, Cobind_tblPartic.CodeQty, Cobind_tblPartic.PartPoolName, Cobind_tblTopLvl.RSVP, Cobind_tblPartic.ID
ORDER BY Cobind_tblPartic.ID;
Thank you again for all your help!
You're query Cobind_qryReport has a parameter that you need to set. if you want to know the parameter name try the following code
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("Cobind_qryReport")
If qdf.Parameters.Count > 0 Then
MsgBox (qdf.Parameters(0).Name)
End If
Update
Since you know you've got a parameter doing select * from Cobind_qryReport it might just be easier to set the parameter and then use the qdf to open the recordset e.g.
Dim rs as DAO.Recordset
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("Cobind_qryReport")
qdf.Parameters(0).Value = 7832
Set foo = qdf.OpenRecordset()
Note: you can use the parameter name in the place of the ordinal when setting the parametervalue
e.g. qdf.Parameters("Foo").value = 7832
I'm performing a data cleansing operation on an access database. I have several duplicate records in a table that I want to consolidate down into one single record. In doing this I will need to update all references to the records that I will be consolidating.
If I know the column name that holds the record id is there a way to find all of the tables in access that contain this column?
You can examine the TableDefs collection and determine which tables contain a field with a given name.
Public Sub TablesWithField(ByVal pName As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strMsg As String
Dim strName As String
On Error GoTo ErrorHandler
Set db = CurrentDb
For Each tdf In db.TableDefs
strName = vbNullString
'ignore system and temporary tables '
If Not (tdf.name Like "MSys*" Or tdf.name Like "~*") Then
strName = tdf.Fields(pName).name
If Len(strName) > 0 Then
Debug.Print tdf.name & ": " & pName
End If
End If
Next tdf
ExitHere:
On Error GoTo 0
Set tdf = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3265 'Item not found in this collection. '
Resume Next
Case Else
strMsg = "Error " & Err.Number & " (" & Err.description _
& ") in procedure TablesWithField"
MsgBox strMsg
GoTo ExitHere
End Select
End Sub
Short answer: Yes. And there are many ways to skin that cat. Two ideas:
(1) Via VBA, make use of: Application.CurrentDb.TableDefs(i).Fields(j).Name
(2) Via Tools==>Analyze==>Documenter, make a report and then search its output (Publish it with MS Word).
Sorry, but Access isn't built like MS SQL Server or DB2 - the MSys* tables really aren't set up for querying table schemas like that. However, others have VBA based solutions that look useful.
You can use Schemas, not exactly a query, but similar:
Function ListTablesContainingField(SelectFieldName) As String
'Tables returned will include linked tables
'I have added a little error coding. I don't normally do that
'for examples, so don't read anything into it :)
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strTempList As String
On Error GoTo Error_Trap
Set cn = CurrentProject.Connection
'Get names of all tables that have a column called <SelectFieldName>
Set rs = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, Empty, SelectFieldName))
'List the tables that have been selected
While Not rs.EOF
'Exclude MS system tables
If Left(rs!Table_Name, 4) <> "MSys" Then
strTempList = strTempList & "," & rs!Table_Name
End If
rs.MoveNext
Wend
ListTablesContainingField = Mid(strTempList, 2)
Exit_Here:
rs.Close
Set cn = Nothing
Exit Function
Error_Trap:
MsgBox Err.Description
Resume Exit_Here
End Function