I have an append query that is trying to append some records to one of my tables. However, I am getting an error that says “didn’t add 1200 records due to key violations.” 1200 is the total number of records I am trying to append. I don’t understand why I am getting this error because all of my columns in the destination table allow duplicates (even though this append query doesn’t duplicate any information), and if I copy the structure of the table and append the records to that, everything works.
The problem seems to be that I am appending data to a table which already has existing data. Can someone please offer some suggestions for how I can work around this?
Thanks
Verify you haven't overlooked any unique indexes on your table. Save this procedure in a standard module and call it from the Immediate Window with the name of your destination table.
Public Sub InspectIndexes(ByVal pTable As String)
Dim db As DAO.Database
Dim i As Long
Dim j As Long
Dim strFields As String
Set db = CurrentDb
With db.TableDefs(pTable)
Debug.Print "Indexes.Count = "; .Indexes.Count
For i = 0 To (.Indexes.Count - 1)
With .Indexes(i)
Debug.Print i + 1 & ": Index Name = "; .name
If .Primary Then
Debug.Print vbTab & "Primary Key (Unique)"
Else
Debug.Print vbTab & "Unique: "; .Unique
End If
Debug.Print vbTab & "Fields.Count = "; .Fields.Count
strFields = vbNullString
For j = 0 To (.Fields.Count - 1)
strFields = strFields & "; " & .Fields(j).name
Next j
strFields = Mid(strFields, 3)
Debug.Print vbTab & "Fields: "; strFields
End With
Next i
End With
Set db = Nothing
End Sub
Here is sample output where tblFoo has 3 indexes: primary key (unique by definition) on id; a unique index on num_field1 and num_field2; and a non-unique index on parent_id.
InspectIndexes "tblfoo"
Indexes.Count = 3
1: Index Name = both_num_fields
Unique: True
Fields.Count = 2
Fields: num_field1; num_field2
2: Index Name = parent_id
Unique: False
Fields.Count = 1
Fields: parent_id
3: Index Name = pkey
Primary Key (Unique)
Fields.Count = 1
Fields: id
Related
Alright, so here's what happened :
I had a wide table, that needed to be a long table. I used the code below (CODE 1) to fix that problem:
It seemed to have worked, though I am now finding minor errors in the data, while I will need to resolve those, that isn't what this question is about.
In the end, my table looks correctly, and here is an actual record from the database, in fact it is the record that called my attention to the issues:
tbl_CompletedTrainings:
ID
Employee
Training
CompletedDate
306
Victoria
Clozaril
5/18/2016
306
20
8
5/18/2016
the second row is to show what the database is actually seeing (FK with both Employee and Training tables) Those tables have the following formats:
tbl_employeeInformation:
ID
LastName
FirstName
Address
Line2
City
State
Zip
Site1
Site2
Site3
20
A.
Victoria
6 Street
City
State
00000
3NNNN
4
Eric
A.
15 Street
City
State
00000
3nnnnn
tbl_Trainings:
AutoID
TrainingName
Expiration
6
Bloodborne
Annual
8
Clozaril
Annual
When the query in (CODE 2) is run on this table, the following record is returned
report Query:
LastName
FirstName
Training
CompletedDate
Site1
Site2
Site3
ID
Accccc
Eric
Bloodborne Pathogens
5/18/2016
3NN-NN
N/A
N/A
306
Notice that the ID in the report Query is only there as I was checking records, and is called from the tbl_CompletedTrainings. So here's the question, What is happening?! If the record was just wrong, and not pulled I could understand it, but that's not what's happening. Worse still is the date is the correct date for the training the query returns, but not for the training listed in the table.
Related issue, possibly, I had noticed that when I queried the table with a call on the foreign key, it returns records that are 2 off of the requested training number. Notice that this is the case here as well. The training listed, Clozaril, is exactly two further down the line than the training Bloodborne Pathogens, Key 8 and 6 respectively.
Any help would be very much appreciated in this matter, as I can't seem to catch what is causing the issue. Yet it must be something.
(CODE 1)
Option Compare Database
Option Explicit
Sub unXtab()
On Error GoTo ErrHandler
Dim db As DAO.Database
Dim rsxtab As DAO.Recordset
Dim rsutab As DAO.Recordset
Dim counter As Integer
Dim loopint As Integer
Dim qryGetNameID As DAO.Recordset
Dim qryGetTrainingNameID As DAO.Recordset
Dim expires As Date
Dim namevar As String
Dim lname As String
Dim fname As String
Set db = CurrentDb
Set rsxtab = db.OpenRecordset("SELECT * FROM [Employee Training Log];")
If Not (rsxtab.BOF And rsxtab.EOF) Then
db.Execute "DELETE * FROM tbl_CompletedTrainings;"
Set rsutab = db.OpenRecordset("SELECT * FROM tbl_CompletedTrainings WHERE 1 = 2;")
counter = rsxtab.Fields.Count - 1
Do
For loopint = 2 To counter
namevar = rsxtab.Fields(loopint).Name
lname = rsxtab("[Last Name]")
fname = rsxtab("[First Name]")
Select Case namevar
Case "First Name"
Case "Last Name"
Case "Date of Hire"
Case Else
If rsxtab.Fields(loopint) <> "" Or Not IsNull(rsxtab.Fields(loopint)) Then
Set qryGetTrainingNameID = db.OpenRecordset("SELECT AutoID FROM Trainings WHERE [Training Name] = " & Chr(34) & namevar & Chr(34) & ";")
Set qryGetNameID = db.OpenRecordset("SELECT ID FROM tbl_EmployeeInformation WHERE LastName = " & Chr(34) & lname & Chr(34) & _
" AND " & Chr(34) & fname & Chr(34) & ";")
rsutab.AddNew
Debug.Print lname
Debug.Print fname
Debug.Print namevar
Debug.Print qryGetNameID.Fields(0)
Debug.Print qryGetTrainingNameID.Fields(0)
rsutab.AddNew
rsutab("Employee") = qryGetNameID.Fields(0)
rsutab("Training") = qryGetTrainingNameID.Fields(0)
rsutab("CompletedDate") = rsxtab.Fields(loopint)
rsutab.Update
End If
End Select
Next loopint
rsxtab.MoveNext
Loop Until rsxtab.EOF
End If
exitSub:
On Error Resume Next
rsxtab.Close
rsutab.Close
Set rsxtab = Nothing
Set rsutab = Nothing
Set db = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Number & " : " & Err.Description & vbCrLf & vbCrLf & " on this field: " & namevar, vbOKOnly + vbCritical
End Sub
(CODE 2)
SELECT EI.LastName, EI.FirstName, T.TrainingName AS Training, CT.CompletedDate, EI.Site1, EI.Site2, EI.Site3, CT.ID
FROM tbl_EmployeeInformation AS EI
INNER JOIN (tbl_CompletedTrainings AS CT
INNER JOIN tbl_Trainings AS T ON CT.Training = T.AutoID) ON EI.ID = CT.Employee;
I want to fetch TOP N random records from the table but not more than 2 records for same name.
SELECT TOP 7 Table1.ID, Table1.Name, Table1.Salary, Rnd(Abs([Table1]![id])) AS Expr1
FROM Table1
GROUP BY Table1.ID, Table1.Name, Table1.Salary, Rnd(Abs([Table1]![id]))
ORDER BY Rnd(Abs([Table1]![id]));
It is giving more than two records for same name. Would someone please provide some assistance.
Use this query:
SELECT
ID,
[Name]
FROM
[Table1]
ORDER BY
Rnd(-Timer()*[ID]);
Then open it as a Recordset and traverse it from the start and pick IDs (could be saved in an array) while recording the the Name used (a Collection could be used for this).
If a Name has been used twice, skip the record and move to the next.
When you have picked seven IDs, stop. The array of IDs will identify your seven records.
Save the query as RandomAll. Then use it in this function:
Public Function RandomTwo() As long()
Dim rs As DAO.Recordset
Dim Names As New Collection
Dim Used As Integer
Dim Index As Integer
Dim Ids() As Long
Set rs = CurrentDb.OpenRecordset("RandomAll")
ReDim Ids(0)
Do While Not rs.EOF
Used = 0
' Read used count. Will fail if not used.
On Error Resume Next
Used = Val(Names.Item(rs.Fields(1).Value))
On Error GoTo 0
Debug.Print Used, ;
If Used = 1 Then
' Remove key to be added later with updated use count.
Names.Remove rs.Fields(1).Value
End If
If Used < 2 Then
' Record the use count (as text) of the key.
Names.Add CStr(Used + 1), rs.Fields(1).Value
Debug.Print rs!ID.Value, rs.Fields(1).Value
' Add ID to array.
Ids(UBound(Ids)) = rs!ID.Value
If UBound(Ids) = 6 Then
' Seven IDs found.
Exit Do
Else
' Prepare for next ID.
ReDim Preserve Ids(UBound(Ids) + 1)
End If
End If
rs.MoveNext
Loop
rs.Close
' List the found IDs.
For Index = LBound(Ids) To UBound(Ids)
Debug.Print Index, Ids(Index)
Next
' Return the IDs.
RandomTwo = Ids
End Function
The function will return the array holding the seven IDs.
Taking inspiration from Gustav's answer I have designed a bit of VBA code that will generate a SQL string which when used will give you N amount of random records with a limit of 2 per name.
Const PicksLimit As Long = 7 'How many records do you want to select
Dim rs As DAO.Recordset
'Select randomised table
Set rs = CurrentDb.OpenRecordset("SELECT ID, Name From Table1 ORDER BY Rnd(Abs(ID))")
'Define variables for keeping track of picked IDs
Dim Picks As Long, PickNames As String, PicksSQL As String
Picks = 0
PickNames = ""
PicksSQL = ""
With rs
If Not (.BOF And .EOF) Then 'If table is not empty...
.MoveFirst
'Loop until limit reached or table fully looked through
Do Until Picks = PicksLimit Or .EOF
'If name has been picked less than twice before
If Len(PickNames) - Len(Replace(PickNames, "[" & !Name & "]", "")) < ((Len(!Name) + 2) * 2) Then
Picks = Picks + 1 'Increment counter
PickNames = PickNames & "[" & !Name & "]" 'Add name for later checks
PicksSQL = PicksSQL & "ID = " & !Id & " OR " 'Append SQL string
End If
.MoveNext
Loop
'Add front sql section and remove last OR
PicksSQL = "SELECT * FROM Table1 WHERE " & Left(PicksSQL, Len(PicksSQL) - 4)
Else
'If the table is empty no need for ID checks
PicksSQL = "SELECT * FROM Table1"
End If
End With
rs.Close
Set rs = Nothing
'Print SQL String (This can be changed to set a RecordSource or similar
Debug.Print (PicksSQL)
At the moment the SQL string is just printed to the Immediate window but this can be changed to go wherever you need, like a subform's RecordSource for instance.
The code will need to be run every time you want a new random list but it shouldn't take a huge amount of time so I don't see that being too big an issue.
I am an old Foxpro programmer and I use to use arrays to post variable fields.
What I am trying to do is I have 15 date fields in the new table I designed.
In my query I have individual records with one date for activity.
I want to compile the 15 different dates for a each Client_id into one record with 15 dates but I can't seem to reference the table data as an array.
I have tried a couple different methods of defining the array but nothing seems to work.
Here is my code that I have. In my table I have 15 date fields named Mail_date1, Mail_date2, Mail_date3, etc.
I tried first defining it just as an array but did not like it; my code always fails when I try to reference the date field in the result table rs2!mdate2 = memdate(intcounter)
How can I reference my result table output fields as an array?
Do I have to put a whole bunch of if statements to load my results?
Seems like a waste.... should be able to load them as an array.
I am a new Access 2007 VBA programmer.
Dim db As DAO.Database
Set db = CurrentDb
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim FinTotal, intcounter As Integer
Dim FinMPU, FinVersion As String
Dim mail_date(1 To 15) As Date
Dim memdate(1 To 15) As Date
Dim mdate2 As String
Set rs1 = db.OpenRecordset( _
"SELECT NewFile.MPU_ID, " & _
" NewFile.MAIL_DATE," & _
" NewFile.TOTAL, " & _
" Freight.Version " &_
"FROM Freight " & _
" LEFT JOIN NewFile ON Freight.[MPU ID] = NewFile.MPU_ID " & _
"ORDER BY NewFile.MPU_ID, NewFile.MAIL_DATE")
Set rs2 = db.OpenRecordset("Final")
DoCmd.RunSQL "DELETE Final.* FROM Final;"
intcounter = 1
memdate(intcounter) = rs1!mail_date
FinMPU = rs1!mpu_ID
FinTotal = rs1!total
FinVersion = rs1!Version
rs1.MoveNext
On Error GoTo Error_MayCauseAnError
Do While Not rs1.EOF
Do While Not rs1.EOF _
And memdate(intcounter) <> rs1!mail_date _
And FinMPU = rs1!mpu_ID
intcounter = intcounter + 1
memdate(intcounter) = rs1!mail_date
FinTotal = FinTotal + rs1!total
FinVersion = rs1!Version
FinMPU = rs1!mpu_ID
rs1.MoveNext
Loop
If FinMPU <> rs1!mpu_ID Then
rs2.AddNew
mdate2 = "mail_date" & CStr(intcounter)
rs2!mdate2 = memdate(intcounter)
rs2!total = FinTotal
rs2!mpu_ID = FinMPU
rs2!Version = FinVersion
rs2.Update
FinTotal = rs1!total
FinVersion = rs1!Version
FinMPU = rs1!mpu_ID
intcounter = 1
memdate(intcounter) = rs1!mail_date
End If
rs1.MoveNext
Loop
first, if you expect and answer, you should really spend more time on properly formatting your explanation and your code...
Now, for some remarks and possible answer to the question:
You should DELETE FROM Final before you open that table in a recordset.
You should be explicit about the type of recordset you are opening:
' Open as Read-only '
Set rs1 = db.OpenRecordSet("...", dbOpenSnapshot)
' Open as Read/Write '
Set rs1 = db.OpenRecordSet("...", dbOpenDynaset)
You should Dim memdate(1 To 15) As Variant instead of Date as the Date datatype cannot be Null, and since you are pulling data from a LEFT JOIN, it's possible that the returned values could be Null if there are no corresponding data to Freight in the table Newfile.
That On Error GoTo Error_MayCauseAnError should probably not be there.
Use On Error Goto only to catch errors you can't deal with at all.
Using that here will only hide errors in your code. With some proper checks statements you should not even need the On Error Goto...
It looks like your first internal loop is trying to skip some records.
However, when that loop breaks, it could be because it reached EOF, and you never test for that in the code that follows the loop.
You never test if your intcounter goes beyond the 15 allocated dates.
Are you absolutely sure that you can never have more than 15 records?
You do not say which error message you get exactly. That could be useful to help determine the kind of issue at hand.
Instead of
mdate2 = "mail_date" & CStr(intcounter)
rs2!mdate2 = memdate(intcounter)
Use
rs2.Fields("mail_date" & intcounter).Value = memdate(intcounter)
the ! syntax of DAO really only is a shorthand for the longer rs.Fields("name") form.
I have a MS Access DB with a primary key on the parent table and 82 other tables.
New data will be coming with new name for the primary key
Before New
RS182 X182RS
RS188 X188RS
RD301 X301RD
Is there a way to rename the primary key value in bulk on all the tables in the DB because I want to associate all previous historical data to the new name value.
Based on that sample, it seems there is a consistent pattern between the new and old primary key values.
? "X" & Right("RS182", 3) & Left("RS182", 2)
X182RS
If that is true, then use a series of UPDATE statements to replace the old values with the new. But first make a backup copy of your database for safekeeping.
For example, if the primary key field for YourTable is named ID:
UPDATE YourTable
Set ID = "X" & Right(ID, 3) & Left(ID, 2);
If YourTable is included in any defined relationships, you will first need to drop those relationships (or at least uncheck the "enforce referential integrity" option for them), then restore the relationships after updating the primary key values.
Also removing the primary key property from ID should allow the UPDATE to complete faster. Re-assign the primary key afterward.
Since you have 82 tables which require this conversion, you could create a VBA procedure to do it.
Public Sub ConvertPKeyValues(ByVal pTable As String, _
ByVal pField As String)
Dim db As DAO.Database
Dim strSql As String
strSql = "UPDATE [" & pTable & "]" & vbCrLf & _
"Set [" & pField & "] = 'X' & " & _
"Right([" & pField & "], 3) & " & _
"Left([" & pField & "], 2);"
Set db = CurrentDb
db.Execute strSql, dbFailOnError
Set db = Nothing
End Sub
Call the procedure with each table name and the name of the relevant field in that table. You should also add an error handler for any problems which dbFailOnError exposes.
It's not that hard to code, at least if I understand the following correct from your question:
the primary key column exists in every table
it has the same name in every table (I'll use ID in my example)
the existing values are all in the same format ("RS182" --> two letters and three numbers)
To get a list of all tables in your database, you can take a look at the hidden table MSysObjects.
And then you just have to loop through the tables and update the ID column.
A quick example (works on my machine):
Public Function Test()
Dim RS As DAO.Recordset
Dim SQL As String
SQL = "select name from msysobjects where type = 1 and name not like 'msys*'"
Set RS = CurrentDb.OpenRecordset(SQL)
Do While Not RS.EOF
SQL = "update " & RS("name") & " set ID = 'X' & Mid([ID],3) & Left([ID],2);"
CurrentDb.Execute SQL, dbFailOnError
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
End Function
You cannot modify a PK if you have related records in the other tables.
So the trick here is to temporarily modify all those relationships (I suppose they exist and that Referential Integrity is enabled - otherwise I wouldn't even talk to you :), and enable the Cascade Update option.
Don't forget to turn that option off once your data goes back in prod !!
So, we have imported data which we have queried and then created a pivot table off that query. It is essentially a list of files, each having unique ID numbers, and various attributes (file extension, type of document, hash, etc). In any case, this data is based off "hits" on keyword searches from a different program. This means that there might be multiple records for the same Unique ID since there are multiple hits.
The pivot table allows us to illustrate/manipulate via filtering out certain criteria (e.g. we don't want certain file extensions or we don't want records with FIELD X or FIELD Y0. The report is fine, but we want to make a form/query/report/whatever that will pull a "count" (based off unique ID) which ignores duplicates. For example, once all the filters are set in the pivot table, based on the filters/output of the pivot table, we want something like this:
.PDF Files: 200 | total for field x | total field y | etc
.DOCX files: 320 | total for field x | total for field y | etc
Obviously, we want to ignore duplicates of the same Unique ID in the counts.
What is the best way to do this considering we will be manipulating the pivot table dynamically and often? The ideal scenario would to have the pivot table and another object (form/report/etc) open, and as the pivot table is manipulated whatever is displaying counts changes as well.
Here are some very rough notes notes. They are only minimally tested, and using IN would be a disaster with a lot of values, however, it would be easy enough to switch this round and use an excluded list. Perhaps you can get some ideas.
Dim oPTable ''PivotTable
Dim oPM ''PivotMember
Dim oFUpd ''PivotFilterUpdate
Dim oChildren ''ChildMembers
Dim fset ''FieldSet
Dim sWhere As String
Dim sTemp As String
Dim sSQL As String
Dim sDelim As String
Dim aStates As Variant
Dim i As Integer
Dim rs As DAO.Recordset
sDelim = """"
aStates = Array("Cleared", "Checked") ''Possible states
Set oPTable = Forms(0).PivotTable.ActiveView
sWhere = vbNullString
For Each fset In oPTable.FieldSets
sTemp = vbNullString
Set oChildren = oPTable.FieldSets(fset).Member.ChildMembers
For i = 0 To oChildren.Count - 1
Set oPM = oChildren(i)
Set oFUpd = oPM.Field.FieldSet.CreateFilterUpdate
If aStates(oFUpd.StateOf(oPM) - 1) = "Checked" Then
Select Case fset.BoundField.DataType
Case adChar, adLongVarWChar
sTemp = sTemp & "," & sDelim & oPM.Caption & sDelim
Case adInteger
sTemp = sTemp & "," & oPM.Caption
Case adDate
sTemp = sTemp & ",#" & oPM.Caption & "#"
Case Else
'' The above is a very short list.
'' Stop
End Select
End If
Next
If sTemp > vbNullString Then
sWhere = sWhere _
& " AND [" & fset.Name & "] IN ( " & Mid(sTemp, 2) & ")"
End If
Next
sSQL = "SELECT DISTINCT ID FROM [" & oPTable.Control.DataMemberCaption & "] "
sSQL = sSQL & "WHERE 1=1" & sWhere
Set rs = CurrentDb.OpenRecordset(sSQL)
MsgBox "Unique: " & rs.RecordCount
if that helps:
http://lazyvba.blogspot.com/2010/11/improve-your-pivot-table-to-count.html
it will get you the unique count of ID numbers by numbers you want, and you can still manipulate the pivot