Hi Ajax Thank you yes this is what I am looking for, the only problem when I run it, it gives me 5332 words, but make acces very very slow, is there a way to make it faster
suggest ensure the fWord field is indexed and does not allow duplicates - or make it the primary key and remove your ID field unless you have reasons for needing the numerical value
Other than that, not much else you can do - I'll remind you the original requirement was 'When I add new data to a table' so this should only run on a single record, not thousands.
Only other way would be a complete redesign of your database and will probably make it unusable for other functions
so instead of the a table like table1 in my example you would have two tables
tblPK - just to create a unique ID for the phrase - might also contain additional fields to represent Blokkies. tblSynonyms and the column
tablePK autonumber
tblWords
WordsPK autonumber
tableFK long - link to tblPK
tWord -text - indexed duplicates OK
tOrder- integer
populated like this
tblPK
tablePK
1
2
3
tblWords
WordsPK....tableFK...tWord........tOrder
1...............1...........Tomorrow...1
2...............1...........never.........2
3...............1...........dies...........3
4...............2...........Quick.........1
5...............2...........brown........2
6...............2........... fox...........3
7...............3........... Hello........1
8...............3........... World.......2
then you can index tWord (duplicates OK) and link directly using a left join to fWord in wordlist along the lines AccessTo was suggesting
Thank you Ajax, will paly with this and see how it is going
Hi Hendrick!
I am sorry but, I didn't realize that you was talking about phrases and not only about single words.
Ajax inspired me to create the function that follows.
It creates a new table with the words of the specified field of a specified table (or query) that there aren't in table Wordlist.
Parameters:Code:Function NewWordsInTable(ByRef strTable As String, ByVal strField As String) As Boolean 'Requires a reference to Microsoft ActiveX Data Objects x.x Library. Dim db As DAO.Database Dim rs As ADODB.Recordset Dim strWordlist As String Dim strWordsCheck As String Dim varWords As Variant Dim fRetVal As Boolean Dim i As Long On Error GoTo ErrH Set rs = New ADODB.Recordset rs.ActiveConnection = CurrentProject.Connection 'Get records from the input table. rs.Open "SELECT [" & strField & "] FROM [" & strTable & "] where not [" & strField & "] is null", , adOpenStatic, adLockReadOnly 'Create a single string by all returned words/phrases to be checked. If Not (rs.BOF And rs.EOF) Then strWordsCheck = rs.GetString(, , , " ") rs.Close 'Remove double spaces. 'Also, you need a "clean-up" function here if there are special characters to remove. While InStr(1, strWordsCheck, " ") > 0 strWordsCheck = Replace(strWordsCheck, " ", " ") Wend strWordsCheck = Trim(strWordsCheck) If Len(strWordsCheck) Then 'There are words to check. 'Make an array of all words to be checked. varWords = Split(strWordsCheck) 'Get all maching words stored in Wordlist table. rs.Open "SELECT FWord FROM Wordlist WHERE FWord IN('" & Join(varWords, "','") & "')", , adOpenStatic, adLockReadOnly 'Create a single string by returned words. If Not (rs.BOF And rs.EOF) Then strWordlist = rs.GetString(, , , " ") rs.Close Set db = CurrentDb 'Prepare the name of the table for the new words. strTable = strTable & "_" & strField & "_NewWords" 'Delete it if exists. db.Execute "DROP TABLE [" & strTable & "];" 'Create the table for the new words. db.Execute "CREATE TABLE [" & strTable & "] ([" & strField & "] text(50) not null CONSTRAINT UW UNIQUE);" On Error Resume Next If Len(strWordlist) = 0 Then 'All words are new. For i = LBound(varWords) To UBound(varWords) 'Append the word in new table. db.Execute "INSERT INTO [" & strTable & "] ([" & strField & "]) VALUES ('" & varWords(i) & "');", dbFailOnError Next i fRetVal = True Else 'Need to search for matching words. For i = LBound(varWords) To UBound(varWords) 'Search this word in all words of Wordlist. If InStr(1, strWordlist, varWords(i)) = 0 Then 'Not found. Append the word in new table. db.Execute "INSERT INTO [" & strTable & "] ([" & strField & "]) VALUES ('" & varWords(i) & "');", dbFailOnError fRetVal = True End If Next i End If NewWordsInTable = fRetVal End If ExitHere: On Error Resume Next Set db = Nothing rs.Close Set rs = Nothing Exit Function ErrH: If Err = 3376 Then 'Error "Table does not exist" in "DROP TABLE" statement. Resume Next Else 'Unexpected error. MsgBox Err.Description, vbExclamation, "New Words Error#" & Err Resume ExitHere End If End Function
strTable: Required. String. The name of the table to be searched for new words.
In exit of function contains the name of the temporary table that has been created.
strField: Required. String. The name of the field that contains the words or the phrases to be searched.
Return value:
TRUE if new words found.
For example, if you run it asthen, you will find a table with name tblSynonyms_theword_NewWords with the new words (if found) from field theword.Code:NewWordsInTable "tblSynonyms", "theword"
Below is an example that demostrate how you can use it:
Important: It use ADODB.Recordset, so, you must add a reference to Microsoft ActiveX Data Objects x.x Library in Tools-->References...Code:Sub TestNewWordsInTable() Dim strTable As String strTable = "tblSynonyms" 'Check for new words in the field "theword" of table "tblSynonyms". If NewWordsInTable(strTable, "theword") Then 'Now the strTable has the name of the temporary table with the new words ("tblSynonyms_theword_NewWords"). 'New words found! If MsgBox("There are new words in '" & strTable & "'" & vbCrLf & vbCrLf _ & "Do you want to append them into table 'Wordlist' now?", vbQuestion + vbYesNo, "New words") = vbYes Then 'Append new words into table "Wordlist" and delete them from temporary table. With CurrentDb .Execute "INSERT INTO Wordlist (fWord) SELECT theword FROM [" & strTable & "]", dbFailOnError .Execute "DELETE fWord FROM [" & strTable & "]", dbFailOnError End With End If Else 'There are no new words in this field. MsgBox "There are no new words to append.", vbInformation, "New words" End If End Sub
Try it in a copy of your actual database and let me know if you face any problem.
I hope it helps.
Cheers,
John
Last edited by accesstos; 11-04-2019 at 03:53 PM.
Hi John
I have tried to use the code, but when I press the button to run it, it gives error. method 'open' of object'_recordset' failed
I do have Microsoft ActiveX Data Objects x.x Library ticked,
but there are a few of them. 2.0, 2.1, 2.5, 2.6, 2.7, 2.8 and 6.1. Not sure why there are so many, but I have tried all of them but get the same error.
Greetings
Hendrik
Hi, I think your methods will take extremely long.
Other approach: split the sentence in a work table in 1 word per column
add to each table a check field 'Words checked'. Then create for the worktable a union query that puts all word columns in one column:
select distinct colA from TableA left outer join Wordlist on TableA.colA = Wordlist.fWord where Wordlist.fWord Is null and TableA.colIsChecked = 0
UNION
select distinct colB from TableA left outer join Wordlst on TableA.coB = Wordlist.fWord where Wordlist.fWrd is null ad tableA.colIsChcked = 0
UNON
...and so on ..
[Warning: I used SQL Server syntax, Access query syntax might differ a bit]
Transform this query to an append query and run it to add the results to Wordlist
Run a second action query to set the colIsChecked to true
The first time you run this all rows in all tables will have t be checked, but from the second on, only the new ones.
Be sure to index the field fWord in table Wordlist to speed up the query.
Kind regards
Noëlla
Hi Hendrik!Hi John
I have tried to use the code, but when I press the button to run it, it gives error. method 'open' of object'_recordset' failed
I do have Microsoft ActiveX Data Objects x.x Library ticked,
but there are a few of them. 2.0, 2.1, 2.5, 2.6, 2.7, 2.8 and 6.1. Not sure why there are so many, but I have tried all of them but get the same error.
Greetings
Hendrik
In my [old] system, I have set a reference to Microsoft ActiveX Data Objects 2.8 Library in attached sample database and it works properly. Test in your system and if you still have errors, probably something is going on with your system and we will have to leave the functionality of ADODB.Recordset (no big deal).
In addition, I have made some changes in code of NewWordsInTable() and now copy the new words of every table in one table named tblNewWords. Also, incidentally, this way is close to Noëlla's suggestion.
In any case, keep in mind that this is not a completed code yet and probably needs more editing to work perfectly. For example, maybe we have to take care for words that contains special characters and blank spaces in your actually database.
I will wait for your comments.
Cheers,
John
Last edited by accesstos; 11-05-2019 at 03:21 PM. Reason: minor changes in attached file
you can always late bindI have set a reference to Microsoft ActiveX Data Objects 2.8 Library
dim Arst as Object
Set Arst =createobject("Adobe.recordset")
but any adobe constants will also need to be defined
I agree, it's a good option when we want to avoid reference issues, but,
besides the efficiency in run time, in this case, I chose the early binding for the readability of constants.
Ηowever, I don't know, in Hendrick's case, if the late binding solves the problem.
Hi John
This really look good
Thank You, I have copied it over to my access database,
When I run frmwords and choose synonyms it show all the words
When I press button show new words, it shows all the new words, but when I press Append new words in wordlist, it give me error
In my wordlist table I have make field fword (indexed to yes(no duplicates)), so I do not know if this is shy I am getting this error.
When I take the index of, and run it again, it takes very long to find new words.
Ok I got it to work, I have changed indexed to yes(with duplicates), working now.
Will still test it and let you know.
How can I make it that it don't show words (characters) like @ , ' - _ when I want to add new words, it is now showing new words like keep, eg.
Hi Hendrick!
Yes, this occurs because of this type of index.
Change the SQL expression of this line:
with this and try it again:Code:CurrentDb.Execute "INSERT INTO Wordlist (fWord) SELECT fNewWord FROM tblNewWords", dbFailOnError
Code:"INSERT INTO Wordlist (fWord) SELECT n.fNewWord FROM tblNewWords As n LEFT JOIN wordlist AS w ON n.fNewWord = w.fWord WHERE w.fWord Is Null;"This is natural. Table Wordlist have, as you said, 450000 records, and every day you add more, but, probably, we can make something better for that.
This is not so clear.
If you have records in tblNewWords with a single character and you want to remove them to not save them, you need a query like that:(You can add more characters in IN() clause if you want.Code:"DELETE * FROM tblNewWords WHERE fNewWord IN('@',',','-','_',''');
If you want to remove characters from words you have to run an Update query for each character but it's a litle a bit risky because a character maybe be part of a word (e.g. Thank's).
I will wait for you.
Cheers,
John
Hi John I have change my indexed on fword to index yes(no Duplicates), then I have changed the code nad run it
It gives error "Too few Parameters. expected 1.
it gives it when it getsa to else in the code below
Still trying to work out the characters, will be working on this.Code:Private Sub NewWordsAction(Optional wAction As WordsActions) On Error Resume Next If Me.sfrmNewWords.Form.Recordset.RecordCount > 0 Then If wAction = wActionAppend Then CurrentDb.Execute "INSERT INTO Wordlist (fWord) SELECT fNewWord FROM tblNewWords As n LEFT JOIN wordlist AS w ON n.fNewWord = w.fword WHERE s.fWord is Null;", dbFailOnError End If If Err = 0 Then CurrentDb.Execute "DELETE * FROM tblNewWords", dbFailOnError Me.sfrmNewWords.Requery Else MsgBox Err.Description, vbExclamation, "Nuwe Woorde" End If Else MsgBox "Soek asseblief eers vir nuwe woorde!", vbExclamation, "Nuwe Woorde" Me.cmdNewWords.SetFocus End If
I am trying to use this code
It does not delete the .... and , from the below samplesCode:DELETE * FROM tblNewWords WHERE fNewWord IN('@',',','–','_','’n','…');
Kaats…
Jan,
Will gladly like help with this
RegardsThis is natural. Table Wordlist have, as you said, 450000 records, and every day you add more, but, probably, we can make something better for that.
Hendrik
Hi Hendrik!
Usually, this happens when appears values that contains comma or apostrophe (like Jan,) in SQL statements.It gives error "Too few Parameters. expected 1.
Search for words with comma or apostrophe in new words before append.
You can use the Find and Replace dialog or action queries for mass editting but, in table of new words, you can't remove a trailing comma from a word if already exists a same word without a trailing comma (e.g. Jan, and Jan) because the field fNewWord doesn't allow duplicates.Still trying to work out the characters, will be working on this.
So, in the new attached sample database, I have created a new table (tblClean) that allows duplicates, to make the appropriate word editing possible, and then, the "clean" words comes back into tblNewWords. Please, check the new button "Clean new words" and study the code of TrimTrailing() procedure. It attempt to remove trailing non alphanumeric characters using this query:
If you want to remove leading characters too, repeat the query above with the asterisk at the end of LIKE pattern (""[!A-Za-z0-9]*"").Code:CurrentDb.Execute "UPDATE tblClean set [fNewWord]=Left([fNewWord],len([fNewWord])-1) " _ & "WHERE ([fNewWord] Like ""*[!A-Za-z0-9]"");"
In addition, I have change the code of NewWordsInTable() function and I think that is a little bit faster.
For testing, don't copy the objects from the attachment into your database. Import the table Wordlist (structure and data) from your database into the attachment.
Cheers,
John
John, thank you, It is working very well.
Also thank you Ajax and Noella, for your input and help
You are welcome Hemdrick! It was my pleasure to participate in the solution of your issues.
I have to post an addition.
At the sentence below:
I have to add:If you want to remove leading characters too, repeat the query above with the asterisk at the end of LIKE pattern (""[!A-Za-z0-9]*"").
So, the action query has to be:and use the Right() function instead of Left()
Good luck with your project!Code:CurrentDb.Execute "UPDATE tblClean set [fNewWord]=Right([fNewWord],len([fNewWord])-1) " _ & "WHERE ([fNewWord] Like ""[!A-Za-z0-9]*"");"
Regards,
John