Can’t get the SELECT DISTINCT code to work (1 Viewer)

[FAB1]

Hi All, I have a tblImportedEmail field [Emailbody] that contains text with a BookingRef also I have a tblbookings that holds [BookingRef] I wanted access to go through the Emailbody and match it to the [BookingRef] in the tblbookings

As all the BookingRef are in different formats and rarely have any pre-set identifiers eg : or # instr isn’t an option so I believe SELECT DISTINCT would work based from an old code example nschroeder.

I have to admit I just can’t get to the back of this one. Can somebody give me a push in the right direction.

Thanks
FAB1

Option Compare Database
Dim db As Database
Dim rsFindBookingID As Recordset
Dim aInput() As String
Dim strWord As String
Dim a As Integer
Dim strBookingIDQry As String

Private Sub cmdBTSearch_Click()

'Clean up Emailbody and split into single lines
    strTxtVal = Me.EmailBody
    strTxtVal = Replace(strTxtVal, ".", "")  ' Repeat for other characters as needed
    strTxtVal = Replace(strTxtVal, Chr(10), "") ' remove CR
    strTxtVal = Replace(strTxtVal, Chr(13), "") ' remove LF
    aInput = Split(strTxtVal, " ")
   
   For a = 0 To UBound(aInput)
        strWord = aInput(a)
    Me.Refresh
    Next

'Check that text has been cleaned
'    MsgBox (strWord)
    
    strBookingIDQry = "SELECT DISTINCT tblBookings.BookingID, tblBookings.FolioID, tblBookings.SupplierID " & _
                  "FROM tblbookings " & _
                  "WHERE tblbookings.BookingRef=""" & strWord & """;"
    Set rsFindBookingID = db.OpenRecordset(strBookingIDQry)

    With rsFindBookingID
    
        If .RecordCount = 0 Then
          MsgBox "No Match"
         
          
        Else
          txtMatchedBookingRef = !BookingRef
          txtMatchedBookingID = !BookingID
          txtMatchedFolioID = !FolioID
          txtMatchedSupplierID = !SupplierID
        End If
    End With
    
    Set rsFindBookingID = Nothing
End Sub


Private Sub Form_Close()
    Set db = Nothing
End Sub

Private Sub Form_Open(Cancel As Integer)
    Set db = CurrentDb()
End Sub

 

[jdraw]

You should always include
Option Explicit
right below
Option Compare Database

Tell/show us your table(s) design including keys.

 

[pbaldy]

And what exactly do you mean when you say it doesn't work? Do you get an error, if so what's the description, and on what line? Your reference to :

!BookingRef

will fail because that field isn't in the result set. I doubt you need DISTINCT, unless BookingRef can be repeated and you want a single record returned.

 

[FAB1]

Hi jdraw, Thanks for picking up my post. I've attached the accdb also you'll see the Expected results field which i added to show what the code should find.

 

[pbaldy]

Crud, lost a post. For starters, fix the compile errors. Hit Debug/Compile, fix the error, repeat until no error is found. You never set the db variable. This:

    For a = 0 To UBound(aInput)
        strWord = aInput(a)
    Me.Refresh
    Next

Simply replaces strWord until the end, so the following recordset is only using the last word. Presumably you want the recordset inside the loop, repeating until something is found or all words have failed.

 

[FAB1]

Hi pbaldy, thanks for picking up my post. compile errors fixed.

Presumably you want the recordset inside the loop, repeating until something is found or all words have failed.

Yes please. I get the result MsgBox "No Match"

Option Compare Database
Option Explicit

Private Sub cmdBTSearch_Click()

Dim db As DAO.Database
'Dim db As Database
Dim rsFindBookingID As DAO.Recordset

Dim aInput() As String
Dim strWord As String
Dim a As Integer
Dim strBookingIDQry As String
Dim strTxtVal As String
Set db = CurrentDb()

'Clean up Emailbody and split into single lines
    strTxtVal = Me.EmailBody
    strTxtVal = Replace(strTxtVal, ".", "")  ' Repeat for other characters as needed
    strTxtVal = Replace(strTxtVal, Chr(10), "") ' remove CR
    strTxtVal = Replace(strTxtVal, Chr(13), "") ' remove LF
    aInput = Split(strTxtVal, " ")
   
    For a = 0 To UBound(aInput)
        strWord = aInput(a)
    
    Next a
   
    Me.Refresh
    
    
    strBookingIDQry = "SELECT DISTINCT tblBookings.BookingID, tblBookings.FolioID, tblBookings.SupplierID " & _
                  "FROM tblbookings " & _
                  "WHERE tblbookings.BookingRef=""" & strWord & """;"
    Set rsFindBookingID = db.OpenRecordset(strBookingIDQry)

    With rsFindBookingID
    
        If .RecordCount = 0 Then
          MsgBox "No Match"
          
        Else
          txtMatchedBookingRef = !BookingRef
          txtMatchedBookingID = !BookingID
          txtMatchedFolioID = !FolioID
          txtMatchedSupplierID = !SupplierID
        End If
    End With
    
    Set rsFindBookingID = Nothing
End Sub

 

[pbaldy]

Did you see the comments on the loop? Your recordset is only testing the last word in the email.

 

[arnelgp]

There will be no match since the number is embedded in a word when you do the replace.
You shoul replace chr(10) with a sinle space char.
Chr(13) with sinle space.
"." With sinle space.
"," with sinle space.

Modify thus:


For a = 0 To UBound(aInput)
strWord = aInput(a)

Next a


To:


For a = 0 To UBound(aInput)
If isnumeric(aInput(a) then
strWord = aInput(a)
Exit for
End if

Next a

 

[arnelgp]

or use RegExp to find the number:

strWord = RegExpr(strTxtVal,"[0-9][0-9]*")

Function RegExpr( _
  StringToCheck As Variant, _
  PatternToUse As Variant, _
  Optional CaseSensitive As Boolean = True) As string

    Dim m As Variant
    Dim Match As Variant
    Dim Re As Object
    Dim rslt As Variant
    
    Set Re = CreateObject("VBScript.RegExp")
    Re.Global = False
    Re.IgnoreCase = Not CaseSensitive
    
     Re.Pattern = PatternToUse
 
     For Each m In Re.Execute(StringToCheck)
         RegExprGetNumber= CStr(m.Value)
         Exit For
     Next

    Set m = Nothing
    Set Re = Nothing
End Function

 

[FAB1]

Me again....Code worked on Record 1 & 2 as expected but Record 3 & 4 failed. I presume because the [BookingRef] is not just numbers. Any ideas?

Code as 03:10 AM post
For a = 0 To UBound(aInput)
If isnumeric(aInput(a) then
strWord = aInput(a)
Exit for
End if

Next a

 

[arnelgp]

Have your code reversed.
Istead of finding what is on the body of the email,
Use a recordset from tblbookings looping on each bookingref if you
Can find it in the email body.
Once you find it the rest of info you need is already available since you are in correct record already.

 

[FAB1]

Ok, Sorry i am really in over my head hear i thought that was what the code was already doing?

   strBookingIDQry = "SELECT DISTINCT tblBookings.BookingID, tblBookings.FolioID, tblBookings.SupplierID " & _                   "FROM tblbookings " & _                   "WHERE tblbookings.BookingRef=""" & strWord & """;"

 

[static]

Dim imported As DAO.Recordset

With CurrentDb.OpenRecordset("select bookingref from tblBookings")
    Do Until .EOF
        Set imported = CurrentDb.OpenRecordset("select * from tblEmailExamples where emailbody like '*" & Trim(.Fields(0)) & "*'")
        If Not imported.EOF Then Debug.Print "Imported email with ID " & imported("importedemailsid") & " contains " & .Fields(0)
        .MoveNext
    Loop
    .Close
End With

loop through imported if there could be more than 1 match.

 

[jdraw]

Fab1,

I took your tables and arnels function (with a small mod) to work through the logic.
I added a record to tblBookings that does not have a record in tblEmailExamples.

added record to tblBookings
BookingID FolioID SupplierID BookingRef
4 666 66 666JTEST
Not sure if it's useful to you, but here is the code, including he modification to arnels RegExpr function.

Option Compare Database

Option Explicit

Function RegExpr( _
  StringToCheck As Variant, _
  PatternToUse As Variant, _
  Optional CaseSensitive As Boolean = True) As Boolean 'String
  RegExpr = False
    Dim m As Variant
    Dim Match As Variant
    Dim Re As Object
    Dim rslt As Variant
    
    Set Re = CreateObject("VBScript.RegExp")
    Re.Global = False
    Re.IgnoreCase = Not CaseSensitive
    
     Re.Pattern = PatternToUse
 
     For Each m In Re.Execute(StringToCheck)
        ' RegExpr = CStr(m.Value)
        RegExpr = True
         Exit For
     Next

    Set m = Nothing
    Set Re = Nothing
End Function

Sub matchEmails()
    Dim i As Integer
    Dim RS2RecCount As Integer
    Dim db As dao.Database
    Dim rs1 As dao.Recordset
    Dim rs2 As dao.Recordset
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("Select bookingref, bookingID, folioID,supplierid from tblBookings;")
    Set rs2 = db.OpenRecordset("Select importedemailsid, emailbody from tblEmailExamples;")
    rs2.MoveLast
    RS2RecCount = rs2.RecordCount
    rs2.MoveFirst
    Do While Not rs1.EOF
        Debug.Print "Looking for " & rs1!Bookingref
        i = 1
        Do While Not rs2.EOF
            
            'Debug.Print "searching in rs2 record " & i
            If RegExpr(rs2!Emailbody, rs1!Bookingref) = True Then
                Debug.Print "bookingID: " & rs1!bookingID & " folioID: " & rs1!FOLIOid & "  Bookingref: " & rs1!Bookingref & "   Found in rs2 record " & i
                rs2.MoveFirst
                Exit Do
            End If
            i = i + 1
            If i > RS2RecCount _
            Then Debug.Print "bookingID: " & rs1!bookingID & " folioID: " & rs1!FOLIOid & "  Bookingref: " & rs1!Bookingref & " NOT  Found in rs2"
            rs2.MoveNext
        Loop
        rs1.MoveNext
    Loop
End Sub

Results in immediate window:

Looking for 123456
bookingID: 1 folioID: 102 Bookingref: 123456 Found in rs2 record 1
Looking for JUK1C4
bookingID: 2 folioID: 1340 Bookingref: JUK1C4 Found in rs2 record 4
Looking for 4323457/S18H
bookingID: 3 folioID: 543 Bookingref: 4323457/S18H Found in rs2 record 3
Looking for 666JTEST
bookingID: 4 folioID: 666 Bookingref: 666JTEST NOT Found in rs2

 

[FAB1]

Hi again jdraw, Ok still trying to get my head around what you’ve done for me. When I am home tonight updating my DB with your code, can I check where I should put the found results in the frm
Me.txtMatchedBookingRef = rs1.BookingRef
Me.txtMatchedBookingID = rs1!BookingID
Me.txtMatchedFolioID = rs1!FolioID
Me.txtMatchedSupplierID = rs1!SupplierID
Is it after “If RegExpr(rs2!EmailBody, rs1!BookingRef) = True Then”

Also if the Email doesn’t have a match with tblbookings. Sorry i should say if a BookingRef isnt found in the email recorded i was going to add in code to start a new record in the frmBookings

DoCmd.OpenForm "frmBookings", acNormal, "", "", acAdd, acNormal
Is it after the final Loop

 

[pbaldy]

I got your code working yesterday on my other computer. The key is moving the recordset test inside the array loop, so each value is tested until a match is found. I also used a Boolean variable to tell whether a match had been found, and if not set the text boxes to blank. Your code to open the add form could be used instead.

 

[jdraw]

Hi again jdraw, Ok still trying to get my head around what you’ve done for me. When I am home tonight updating my DB with your code, can I check where I should put the found results in the frm
Me.txtMatchedBookingRef = rs1.BookingRef
Me.txtMatchedBookingID = rs1!BookingID
Me.txtMatchedFolioID = rs1!FolioID
Me.txtMatchedSupplierID = rs1!SupplierID
Is it after “If RegExpr(rs2!EmailBody, rs1!BookingRef) = True Then”

Also if the Email doesn’t have a match with tblbookings. Sorry i should say if a BookingRef isnt found in the email recorded i was going to add in code to start a new record in the frmBookings

DoCmd.OpenForm "frmBookings", acNormal, "", "", acAdd, acNormal
Is it after the final Loop

All I did was take the basic issue--
--given a set of bookingrefs, see which , if any, EmailBody contains the bookingref. If found, identify the EmailID and the related booking info.

You will notice I used 2 recordsets and 2 Do while loops. One loop is inside the other loop.

I did nothing with the form. I was just trying to get the looping construct set up to work based on your post.

 

[FAB1]

Apologies everybody I'm getting to the confused stage. You have all been so helpful but I have gotten to the stage that I'm not keeping up with what’s going on. Its been years since my last post and I can’t remember having so many people trying to help before.

Sorry jdraw I didn’t mean to come across ungrateful i was just wanting to clarify how to rather than DeBug.Print the found values I wanted the matched values/ID’s in the forms Matched text boxes just like in the original post. I presumed that once I figured out how the code worked and if I knew where the Matched text boxes values wherein the code I presumed it would be the other side of that if /else statement, I could then add my code to start a new recorded in the tblbooking

 

[jdraw]

Fab1,
I was just working on the basic logic.

Sorry jdraw I didn’t mean to come across ungrateful

I did not and do not see any ungratefulness.
What exactly do you want? If you use something like I submitted, you could update your table to identify the matching emailID.
Once you have that you can relate the 2 tables for whatever purpose you can think of.

With a slight change I can match BookingRefs to ImportedEmailsID
and could put the matching values into a table.

Bookingref to Email 123456  matches ImportedEmailsID 1
Bookingref to Email  JUK1C4  matches ImportedEmailsID 4
Bookingref to Email 4323457/S18H  matches ImportedEmailsID 3
bookingID: 4 folioID: 666  Bookingref: 666JTEST NOT  Found in rs2

However, if the importedEmails get different IDs or some other field changes outside your control, then you need to identify what info you have that is consistent.

I'm attaching a sample accdb with a new table tblMatches. You can add fields to tblMatches if you wish, and add those fields to the sub to write the tblMatches records.

You can run the sub MatchEmails. It uses the RegExpr (modified) from arnel, and it populates the new table with matching BookingRef and ImportedEmailsID. You can use this new table to relate your existing tables if necessary. By default, the tblMatches gets emptied and repopulated each time you run MatchEmails. There are comments in the code to remove this approach if you want to keep repeated run info.
Again this does not use your form.

Good luck.

 

[FAB1]

I appreciate the file with the extra capacity of adding the results to tblMatches

What exactly do you want?

I would like to be able to

1.Populate the unbound fields on the frm with the matched results from the tblbooking.
Where would I put this code and is the = control source syntax correct eg rs1!BookingRef

Me.txtMatchedBookingRef = rs1!BookingRef
Me.txtMatchedBookingID = rs1!BookingID
Me.txtMatchedFolioID = rs1!FolioID
Me.txtMatchedSupplierID = rs1!SupplierID

2.If no match is found I would like to know the location to put this code to start a new Booking Record in the frmBooking

Dim MsgBoxNewBooking As Integer
MsgBoxNewBooking = MsgBox("Would you like to start a new booking?", vbYesNo, "No match found")
If MsgBoxNewBooking = vbYes Then
DoCmd.OpenForm "frmBookings", acNormal, "", "", acAdd, acNormal
Else
' Do nothing
End If
End Sub