I am trying to delete duplicate records in MS ACCESS.
I have created a query that is sorted on field name.
I have VBA code that runs through the query, and then when finds a match it deletes the record - however it is not picking up the match.
My code looks as follows:
Dim db As DAO.Database
Dim recIn As DAO.Recordset
Dim strFieldName1 As Variant
Dim strFieldDescr2 As Variant
Dim strDomainCat3 As Variant
Dim strBusinessTerm4 As Variant
Dim strtableName5 As Variant
Dim lngRecordsDeleted As Variant
lngRecordsDeleted = 0
Set db = CurrentDb()
Set recIn = db.OpenRecordset("qryMyRecords")
If recIn.EOF Then
MsgBox ("No Input Records")
recIn.Close
Set recIn = Nothing
Set db = Nothing
Exit Sub
End If
Do
If recIn!FieldName = strFieldName1 And _
recIn!FieldDescr = strFieldDescr2 And _
recIn!DomainCatID = strDomainCat3 And _
recIn!BusinessTermID = strBusinessTerm4 And _
recIn!TableID = strtableName5 Then
recIn.Delete
lngRecordsDeleted = lngRecordsDeleted + 1
Else
strFieldName1 = recIn!FieldName
strFieldDescr2 = recIn!FieldDescr
strDomainCat3 = recIn!DomainCatID
strBusinessTerm4 = recIn!BusinessTermID
strtableName5 = recIn!TableID
End If
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
Set db = Nothing
MsgBox ("You Deleted " & lngRecordsDeleted & " Records")
End Sub
My StrFieldname1, through to to StrTablename5 does populate (after the else statement)
However when I do the compare a second time
If recIn!FieldName = strFieldName1 And _
recIn!FieldDescr = strFieldDescr2 And _
recIn!DomainCatID = strDomainCat3 And _
recIn!BusinessTermID = strBusinessTerm4 And _
recIn!TableID = strtableName5 Then
recIn.Delete
lngRecordsDeleted = lngRecordsDeleted + 1
Even though the values are the same, it moves to the else statement, and never does the record delete.
Now I suspect that this could be because I declared my variables as VARIANT type, but if I use any other type, the code falls over every time it reaches a NULL value in the query, and there are cases where any of the fields from the query can and will be null.
Any suggestions would be greatly appreciated
To expand on what Justin said, use the Nz function in your main If statement, like so:
If Nz(recIn!FieldName, "") = strFieldName1 And _
...
Else
strFieldName1 = Nz(recIn!FieldName, "")
...
I am trying to select records from an Access table using a String variable from the result of a ComboBox selection. I have confirmed the variable (zBEN) contains the correct data when selected. If I manually enter the data in the WHERE part of the statement it works perfectly. If I use zBEN it crashes - I get an error if I don't use the single quotes and I get an empty record set if I use the quotes. The error is 3061, Too few parameters. Expected 1. This error is usually a data type mismatch or incorrect field name.
Private Sub cmdDisplayMembers_Click()
'this displays a record in the dataset - from button click
Dim dbsContacts As DAO.Database
Dim rcdContacts As DAO.Recordset
Dim conArray As Variant 'this is the record array
Dim intArraySize As Integer 'array size
Dim iCtr As Integer 'counter
Dim zBEN As Variant
Dim zName, strSQL As String
zBEN = Me.cbxMembersList
Set dbsContacts = CurrentDb
'this statement works: (and has the combobox value manually entered
strSQL = "SELECT * FROM tblMember_Contact where id_members = '201208FEAR' ORDER BY id_members"
'this statement gives an error 3061, 1:
'strSQL = "SELECT * FROM tblMember_Contact where id_members = zBEN ORDER BY id_members"
'this statement gives an empty record set
'strSQL = "SELECT * FROM tblMember_Contact where id_members = 'zBEN' ORDER BY id_members"
Set rcdContacts = dbsContacts.OpenRecordset(strSQL)
If Not rcdContacts.EOF Then
rcdContacts.MoveFirst 'start the counter at Row #1
intArraySize = rcdContacts.RecordCount
iCtr = 1
ReDim conArray(10)
Do Until rcdContacts.EOF
conArray(iCtr) = rcdContacts.Fields("member_info")
Debug.Print "Item: "; iCtr & " " & conArray(iCtr)
iCtr = iCtr + 1
rcdContacts.MoveNext
Loop
MsgBox ("Error no records")
End If
If IsObject(rcdContacts) Then Set rcdContacts = Nothing
txtCon1 = conArray(1)
txtCon2 = conArray(2)
MsgBox (zBEN)
End Sub
Enclose the criteria in quotes if it's a string. i.e.
strSQL = "SELECT * FROM tblMember_Contact where id_members = '" & zBEN & "' ORDER BY id_members"
You can concatenate the variable's value instead of its name into the SQL statement text as Wayne already suggested:
strSQL = "SELECT * FROM tblMember_Contact where id_members = '" & zBEN & "' ORDER BY id_members"
But if you switch to a parameter query approach, you needn't bother about the quotes:
strSQL = "SELECT * FROM tblMember_Contact where id_members = [which_id] ORDER BY id_members"
Dim qdf As DAO.QueryDef
Set qdf = dbsContacts.CreateQueryDef(vbNullString, strSQL )
qdf.Parameters("which_id").Value = Me!cbxMembersList.Value
Set rcdContacts = qdf.OpenRecordset()
I have an access table with the fields
ID
Field1
Field2
Field3
I also have a word table with headers
ID | Field1 | Field2 | Field3
How can I import automatically all the data from the table into an assess database from the word file ?
Importing automatically doesnt sound easy, but you could do it programmatically.
From Access, you'd do something like this:
dim base as string: base = "INSERT INTO tblname (ID, Field1, Field2, Field3) VALUES ("
dim sql as string
dim ii as long
dim jj as long
dim wrd as object
dim wrdDoc as object
'
docmd.setwarnings false
set wrd = createObject("Word.Application")
wrd.visible = false
set wrdDoc = wrd.Documents.Add("name of word document containing table")
with wrdDoc.Tables(1) 'assuming first table in document
for ii = ? to .Rows.Count 'if the table has column headings, ? = 2, else 1
sql = base
for jj = 1 to 4 '4 = count of columns
sql = sql & iif(jj = 1, "", ",") & CStr(.Cell(ii, jj))
next jj
sql = sql & ")"
docmd.runsql sql
next ii
end with
docmd.setwarnings true
wrd.Quit
set wrddoc = nothing
set wrd = nothing
I've tried many different methods to join the following from;
StockCode Finished_Goods_Codes
100137 2105109
100137 2105110
100137 2105111
To;
StockCode Finished_Goods_Codes
100137 2105109, 2105110, 2105111
My Current Code is as follows;
Public Function ListQuery()
Dim curr As Database
Dim rs As Recordset
Dim SQLCmd As String
Dim productList As String
Set curr = CurrentDb()
SQLCmd = "SELECT Finished_Goods_Codes FROM TEMP_codes WHERE [StockCode] = """ & StockCode & """"
Set rs = curr.OpenRecordset(SQLCmd)
If Not rs.EOF Then
rs.MoveFirst
End If
Do While Not rs.EOF
productList = productList & rs(0) & ", "
rs.MoveNext
Loop
ListQuery = productList
End Function
My Query currently runs the following;
SELECT TEMP_codes.StockCode, ListQuery([Products]) AS [List of Products]
FROM TEMP_codes
GROUP BY TEMP_codes.StockCode;
Could you please help as i'm really stuck on this.
Many Thanks in advance.
Based on the answer given for the question Microsoft Access condense multiple lines in a table, here are the steps:
1 Create the following function
Public Function GetList(SQL As String _
, Optional ColumnDelimeter As String = ", " _
, Optional RowDelimeter As String = vbCrLf) As String
'PURPOSE: to return a combined string from the passed query
'ARGS:
' 1. SQL is a valid Select statement
' 2. ColumnDelimiter is the character(s) that separate each column
' 3. RowDelimiter is the character(s) that separate each row
'RETURN VAL: Concatenated list
'DESIGN NOTES:
'EXAMPLE CALL: =GetList("Select Col1,Col2 From Table1 Where Table1.Key = " & OuterTable.Key)
Const PROCNAME = "GetList"
Const adClipString = 2
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim sResult As String
On Error GoTo ProcErr
Set oConn = CurrentProject.Connection
Set oRS = oConn.Execute(SQL)
sResult = oRS.GetString(adClipString, -1, ColumnDelimeter, RowDelimeter)
If Right(sResult, Len(RowDelimeter)) = RowDelimeter Then
sResult = Mid$(sResult, 1, Len(sResult) - Len(RowDelimeter))
End If
GetList = sResult
oRS.Close
oConn.Close
CleanUp:
Set oRS = Nothing
Set oConn = Nothing
Exit Function
ProcErr:
' insert error handler
Resume CleanUp
End Function
2 Add a Reference for the function in the Module (Tools -> References). Add the Reference Micorosft ActiveX Data Objects 6.1 Library (or the most recent one available).
3 Save the Module with a name different from the function name, say Concatenation
4 Run the following query
SELECT T.StockCode, GetList("Select Finished_Goods_Codes From TEMP_codes As T1 Where T1.StockCode = " & [T].[StockCode],"",", ") AS Finished_Goods_Codes
FROM TEMP_codes AS T
GROUP BY T.StockCode;
Background information: - There are nearly 7000 individuals and there is data about their performances in one, two or three tests.
Every individual has taken the 1st test (let's call it Test M). Some of those who have taken Test M have also taken Test I, and some of those who have taken Test I have also taken Test B.
For the first two tests (M and I), students can score grades I, II, or III. Depending on the grades they are awarded points -- 3 for grade I, 2 for II, 1 for III.
The last Test B is just a pass or a fail result with no grades. Those passing this test get 1 point, with no points for failure. (Well actually, grades are awarded, but all grades are given a common 1 point).
An amateur has entered data to represent these students and their grades in an Excel file. Problem is, this person has done the worst thing possible - he has developed his own notation and entered all test information in a single cell --- and made my life hell.
The file originally had two text columns, one for individual's id, and the second for test info, if one could call it that.
It's horrible, I know, and I am suffering. In the image, if you see "M-II-2 I-III-1" it means the person got grade II in Test M for 2 points and grade III in Test I for 1 point. Some have taken only one test, some two, and some three.
When the file came to me for processing and analyzing the performance of students, I sent it back with instructions to insert 3 additional columns with only the grades for the three tests. The file now looks as follows. Columns C and D represent grades I, II, and III using 1,2 and 3 respectively. Column C is for Test M, column D for Test I. Column E says BA (B Achieved!) if the individual has passed Test B.
Now that you have the above information, let's get to the problem. I don't trust this and want to check whether data in column B matches with data in columns C,D and E.
That is, I want to examine the string in column B and find out whether the figures in columns C,D and E are correct.
All help is really appreciated.
P.S. - I had exported this to MySQL via ODBC and that is why you are seeing those NULLs. I tried doing this in MySQL too, and really will accept a MySQL or an Excel solution, I don't have a preference.
Edit : - See file with sample data
To create a flat file from the original data:
Sub GetData()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String, t As Variant, x As Variant
Dim i As Integer, j As Integer, k As Integer
''This is not the best way to refer to the workbook
''you want, but it is very conveient for notes
''It is probably best to use the name of the workbook.
strFile = ActiveWorkbook.FullName
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [Sheet1$] "
''Open the recordset for more processing
''Cursor Type: 3, adOpenStatic
''Lock Type: 3, adLockOptimistic
''Not everything can be done with every cursor type and
''lock type. See http://www.w3schools.com/ado/met_rs_open.asp
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet for the results
With Worksheets("Sheet2")
''Fill headers into the first row of the worksheet
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Exam"
.Cells(1, 3) = "Grade"
.Cells(1, 4) = "Points"
''Working with the recordset ...
''Counter for Fields/Columns in Recordset and worksheet
''Row one is used with titles, so ...
i = 1
Do While Not rs.EOF
''Store the ID to a string (if it is a long,
''change the type) ...
s = rs!ID
t = Split(rs!testinfo, " ")
For j = 0 To UBound(t)
''(Counter)
i = i + 1
.Cells(i, 1) = s
x = Split(t(j), "-")
For k = 0 To UBound(x)
If t(j) = "BA-1" Then
.Cells(i, 2) = "B"
.Cells(i, 3) = "A"
.Cells(i, 4) = 1
Else
.Cells(i, k + 2) = x(k)
End If
Next
Next
''Keep going
rs.MoveNext
Loop
''Finished with the sheet
End With
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
To check the extra columns:
Sub CheckData()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String, t As Variant, x As Variant
Dim i As Integer, j As Integer, k As Integer
Dim BAErr, MErr, IErr
strFile = ActiveWorkbook.FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [Sheet1$] "
rs.Open strSQL, cn, 3, 3
Do While Not rs.EOF
t = Split(rs!testinfo, " ")
For j = 0 To UBound(t)
x = Split(t(j), "-")
Select Case x(0)
Case "BA"
If rs![test b] <> "BA" Then
BAErr = BAErr & "," & rs!ID
End If
Case "M"
If String(rs![test m], "I") <> x(1) Then
MErr = MErr & "," & rs!ID
End If
Case "I"
If String(rs![test i], "I") <> x(1) Then
IErr = IErr & "," & rs!ID
End If
End Select
Next
rs.MoveNext
Loop
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
If BAErr <> "" Then
MsgBox Mid(BAErr, 2), , "B Errors"
End If
If MErr <> "" Then
MsgBox Mid(MErr, 2), , "M Errors"
End If
If IErr <> "" Then
MsgBox Mid(IErr, 2), , "I Errors"
End If
End Sub