Page 1 of 2 12 LastLast
Results 1 to 40 of 52

Thread: Check for duplicate records

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Check for duplicate records

    Hello,

    I’m not exactly sure how to explain my problem but here I go…

    First off, I must state – I’m no programmer. I can work with simple Microsoft Access databases, but nothing too complicated.

    We have numerous complex VBA routines written for our CAD software (MicroStation) that assist in linking graphic elements to an Access database. The current procedure includes VBA forms developed in MicroStation which uses Microsoft Visual Basic v6.5. For the most part all works fine.

    My problem –
    In the database we track manhole districts, numbers, and labels. The database is called SEWERS.mdb; the table is SAN_MH; and the fields in question are DISTRICT, MH_NO, and LABEL. The field LABEL is actually a combination of DISTRICT and MH_NO separated by a hyphen (e.g., District 12, Manhole 47 Label would be 12-47). I realize we are being redundant with the LABEL field but this is an old DB originally imported from dBASE. There are other old routines coded to use the LABEL field so I just left it in.

    The LABEL field was originally not indexed. I have set Indexed = Yes (No duplicates). This works fine and does not allow dups. In our CAD procedure, if a user enters a duplicate Label (i.e., District + MH_NO), an error pops up stating Duplicate Value. However, after closing the error message box, it proceeds to place the text although not populating the record. We have to re-enter the correct data to populate the table correctly.

    What I’m looking for is the code/procedure that after keying in the DISTRICT and MH_NO field in the form, it checks to see if a LABEL with that combination of DISTRICT-MH_NO exists. If so, exit routine, otherwise proceed. I am aware of Access’s “After Update” event but I do not see anything similar in MicroStation’s form events.

    I have included a couple screen shots of my error and MicroStation's Form properites window.

    Any suggestions would be appreciated.

    Thanks for your time,
    SKK
    Attached Images Attached Images   

  2. #2
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    That error message is being displayed by the VB6 program. You can have the code ignore the message and do something else instead of just displaying the generic Jet message.

    You need to find the event procedure where this error message is being displayed. You say "if a user enters a duplicate Label", which is a little vague. The user probably has to click a command button to add the new label, so open that command button's click event by double clicking the command button in design view. There is probably an error handler in that event procedure along the lines of:
    Code:
    Private Sub cmdAdd_Click()
    On Error Goto cmdAddErr
    
        [some code here to add the new label]
    
    cmdAddExit:
        Exit Sub
    
    cmdAddErr:
        MsgBox Err.Description
        Resume cmdAddExit
    End Sub
    The key is to find the MsgBox command in the error handler. Change that MsgBox line to this:

    MsgBox Err.Description, vbInformation, Err.Number

    Then purposely add a duplicate label. Then look at the msgbox and you'll see the error number in the blue caption bar instead of "MicroStation." Armed with the error number, change the error handler to:
    Code:
    cmdAddErr:
        If Err.Number = # Then
            ' We have a duplicate; do something here
        Else
            MsgBox Err.Description
        End If
        Resume cmdAddExit
    End Sub
    Where you plug the actual error number in place of the pound (#) sign. Once you've gotten this far, you'll at least know where to make your change. You'll probably need to post back here with several more questions before we can this issue totally squared away. Not a problem; we can help you. A good first step would be to post the contents of the commend button's event procedure here so we can see what you're dealing with.

  3. #3
    PowerPoster techgnome's Avatar
    Join Date
    May 2002
    Posts
    34,687

    Re: Check for duplicate records

    Orrrr.... better still.. CHECK first to see if you are going to end up with duplicate data, THEN either add the record or notify the user about duplicate data.

    -tg
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  4. #4
    Fanatic Member louvelle's Avatar
    Join Date
    Jun 2008
    Posts
    513

    Re: Check for duplicate records

    I just use a the FILTER FUNCTION.

    Code:
    Data1.Recordset.Filter = "DISTRICT = '" & txtDISTRICT.text & "' AND MH_NO = '" & txtMH_NO.text & "'"
    
    If Data1.Recordset.EOF = FALSE then      'Found a match!
       MsgBox "Duplicates found!"
    Else
       MsgBox "No duplicates."
    End If
    Use this code if your using DAO(Data Active Object) as a connection for your database..

    Manny Pacquiao once posted in his twitter:
    It doesn't matter if the grammar is wrong, what matter is that you get the message

  5. #5
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Re: Check for duplicate records

    Are you running this from a VB6 program or is everything happening in VBA?

  6. #6

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Thank you all for your quick responses. I’ll have to play with this a bit to see if I can resolve following your suggestions. Again, the problem is I’m not a programmer so this may take some time.

    Ellis Dee –
    Attached is a screen shot of the input form. You will notice the Label, District, and MH No fields in the upper left corner. What ever is entered into District and MH No is displayed in the Label field (and populated in the San_MH table). What’s happening is after entering a value in District and MH No, if a duplicate Label exists, the MicroStation error stating duplicate data appears. I click OK and it proceeds with the routine, displaying the newly entered data. However, it never actually updates the DB since this would create a duplicate record in the Label field. Here’s were I’d want the routine to simply exit. There isn’t a MsgBox per se.

    Hack –
    This may sound real stupid but I don’t know if this is running from VB6 or VBA since it is part of our CAD software (MicroStation). Based on the Help screen, I’d say VB (see attached).

    Thanks again all - I’ll be back,
    Steve Kipping

  7. #7
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Quote Originally Posted by EssKayKay View Post
    However, it never actually updates the DB since this would create a duplicate record in the Label field. Here’s were I’d want the routine to simply exit. There isn’t a MsgBox per se.
    You posted a screen shot of the MsgBox in the OP. The text of that message and the general appearance of it strongly suggests that it isn't a VB MsgBox but instead is a runtime error message generated by Access. However, if that's the case, that means it's an unhandled runtime error, which would immediately terminate your program. Since you say the program continues on its merry way after that message, it's not an unhandled runtime error. Thus, there is a MsgBox command somewhere in the program showing you that message.

    You still haven't cleartly described the user's steps to trying to add the new record. You say "What’s happening is after entering a value in District and MH No, if a duplicate Label exists, the MicroStation error stating duplicate", but that's obviously not the whole story. What does "after entering" mean? Surely it doesn't just mean the user stops typing because the system couldn't know when that would be.

    Let's say the ID you enter is 123. The system can't be trying to add a new record with ID 1 after your first keystroke, then ID 12 after the second, then ID 123 after the last keystroke. How does it know you're finished? At the very least, the textbox has to lose focus. Much more likely is that there is a command button you have to click.

  8. #8

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis Dee,

    OOPS - I see what you are saying - Mea Culpa please. I forgot one important step. After all data is entered into the form, there is an UPDATE command button that must be pressed to commit the record. This is when the error appears.

    1) You key-in 47 in the District field and hit enter or tab > a “47-“ appears in the Label field. As you key-in the numbers, they systematically appears in the Label field – first the 4 after it is keyed, then a 7 when it is keyed, etc.

    2) You key-in 123 in the MH No field > the Label field then displays 47-123 – first 47-1 after the 1 is keyed, then 47-12; finally 47-123.

    3) Click UPDATE – if duplicate record, error appears.

    Code:
    Private Sub cmdUpdate_Click()
    cmdDone.Visible = False
    cmdCancel.Visible = True
    
    If cmdUpdate.Tag = "Edit" Then
        UnLockForm_SanMan
        cmdUpdate.Caption = "Update"
        cmdUpdate.Tag = "Update"
    Else
        CheckForZero
        UpdateSanMan
        ScanDrawingRemoveSANMANText
        CommandState.StartPrimitive New clsPlaceSanTextNode
        LockForm_SanMan
        cmdUpdate.Tag = "Edit"
        cmdUpdate.Caption = "Edit"
        cmdDone.Visible = True
        cmdCancel.Visible = False
        Unload frmSanMH
        frmSanitary.SHOW
    
        MsgBox "Test for duplicate record..."           ' add by SKK 
    
    End If
    End Sub
    I’m assuming somewhere in the UPDATE code is were I would test for the duplicate. Note where I placed the MsgBox "Test for...". Does this make sense? If yes, now I'm stumped.

    Sorry,
    SKK
    Last edited by EssKayKay; Feb 8th, 2010 at 11:21 AM.

  9. #9
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Darn, I was hoping for an error handler. It wouldn't be the ideal solution, but it would definitely be easiest for a novice coder. Looks like we should go with the conventional technique of verifying there is no duplicate before even trying to save it, as techgnome suggested.

    Let's take this one step at a time. Can you post the contents of the CheckForZero and UpdateSanMan functions? In VB6, you can simply right-click them in the code window and choose "Definition" and it'll open up the functions. If you don't have that functionality, just do a text search until you find them.

    Fair warning: We may need you to post several functions before we can get everything totally squared away.

  10. #10

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis Dee,

    I just edited my last post. If you could please review where I placed a message box and see if this makes sense to you.

    SKK

  11. #11
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    No, that's after the fact. It'll end up looking more like:
    Code:
    Private Sub cmdUpdate_Click()
    If CheckForDuplicate() Then
        MsgBox "Duplicate"
    Else
        cmdDone.Visible = False
        cmdCancel.Visible = True
        
        If cmdUpdate.Tag = "Edit" Then
            UnLockForm_SanMan
            cmdUpdate.Caption = "Update"
            cmdUpdate.Tag = "Update"
        Else
            CheckForZero
            UpdateSanMan
            ScanDrawingRemoveSANMANText
            CommandState.StartPrimitive New clsPlaceSanTextNode
            LockForm_SanMan
            cmdUpdate.Tag = "Edit"
            cmdUpdate.Caption = "Edit"
            cmdDone.Visible = True
            cmdCancel.Visible = False
            Unload frmSanMH
            frmSanitary.SHOW
        End If
    End If
    End Sub
    But there is also the matter of figuring out which "tag state" of the command button requires dup checks and which does not. "Edit" and "Update" usually mean the same thing, as opposed to "Add", so the tag states are a little weird at first glance.

  12. #12

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis Dee -

    I've been trying to post the code for CheckForZero() and UpdateSanMan() functions but appears they won't go through. They are both very long (150+ lines each). I'll try posting separatly.

    Code:
    Private Sub CheckForZero()
    'Need to check both Invert Boxes for a zero to be added.
    'Find the "." and look two digits from there.
    
    Dim RimElevation As String
    Dim OutInv1 As String
    Dim OutInv2 As String
    Dim Invert1 As String
    Dim Invert2 As String
    Dim Invert3 As String
    Dim Invert4 As String
    Dim Invert5 As String
    Dim myPOS As Integer
    
    
    RimElevation = txtRim_Elev.Text
    OutInv1 = txtOUTFL_INV1.Text
    OutInv2 = txtOUTFL_INV2.Text
    Invert1 = txtINFL_INV1.Text
    Invert2 = txtINFL_INV2.Text
    Invert3 = txtINFL_INV3.Text
    Invert4 = txtINFL_INV4.Text
    Invert5 = txtINFL_INV5.Text
    
    If Trim(Len(RimElevation)) > 2 Then
        myPOS = InStr(1, RimElevation, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(RimElevation, 3), 1, 1) = "." Then
                RimElevation = RimElevation
            Else
                RimElevation = RimElevation + "0"
            End If
        Else
            RimElevation = RimElevation + ".00"
        End If
       
    End If
    
    If Trim(Len(OutInv1)) > 2 Then
        myPOS = InStr(1, OutInv1, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(OutInv1, 3), 1, 1) = "." Then
                OutInv1 = OutInv1
            Else
                OutInv1 = OutInv1 + "0"
            End If
        Else
                OutInv1 = OutInv1 + ".00"
        End If
    End If
    
    If Trim(Len(OutInv2)) > 2 Then
        myPOS = InStr(1, OutInv2, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(OutInv2, 3), 1, 1) = "." Then
                OutInv2 = OutInv2
            Else
                OutInv2 = OutInv2 + "0"
            End If
        Else
            OutInv2 = OutInv2 + ".00"
        End If
    End If
    
    If Trim(Len(Invert1)) > 2 Then
        myPOS = InStr(1, Invert1, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(Invert1, 3), 1, 1) = "." Then
                Invert1 = Invert1
            Else
                Invert1 = Invert1 + "0"
            End If
        Else
            Invert1 = Invert1 + ".00"
        End If
    End If
            
    If Trim(Len(Invert2)) > 2 Then
        myPOS = InStr(1, Invert2, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(Invert2, 3), 1, 1) = "." Then
                Invert2 = Invert2
            Else
                Invert2 = Invert2 + "0"
            End If
        Else
            Invert2 = Invert2 + ".00"
        End If
    End If
    
    If Trim(Len(Invert3)) > 2 Then
        myPOS = InStr(1, Invert3, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(Invert3, 3), 1, 1) = "." Then
                Invert3 = Invert3
            Else
                Invert3 = Invert3 + "0"
            End If
        Else
            Invert3 = Invert3 + ".00"
        End If
    End If
            
    If Trim(Len(Invert4)) > 2 Then
        myPOS = InStr(1, Invert4, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(Invert4, 3), 1, 1) = "." Then
                Invert4 = Invert4
            Else
                Invert4 = Invert4 + "0"
            End If
        Else
                Invert4 = Invert4 + ".00"
        End If
    End If
    
    If Trim(Len(Invert5)) > 2 Then
        myPOS = InStr(1, Invert5, ".", 1)
        If myPOS <> 0 Then
            If Mid(Right(Invert5, 3), 1, 1) = "." Then
                Invert5 = Invert5
            Else
                Invert5 = Invert5 + "0"
            End If
        Else
                Invert5 = Invert5 + ".00"
        End If
    End If
           
    txtRim_Elev.Text = RimElevation
    txtOUTFL_INV1.Text = OutInv1
    txtOUTFL_INV2.Text = OutInv2
    txtINFL_INV1.Text = Invert1
    txtINFL_INV2.Text = Invert2
    txtINFL_INV3.Text = Invert3
    txtINFL_INV4.Text = Invert4
    txtINFL_INV5.Text = Invert5
    
    End Sub

  13. #13

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Here's the second. The code was too long so I had to eliminate some of it - I believe it demonstates what's happening.


    Code:
    Private Sub UpdateSanMan()
    
        Dim sUpdate As String
        sUpdate = "update SAN_MH set Label ="
        
        If Not Trim(txtLabel.Text) = "" Then
            sUpdate = sUpdate + """" + Trim(txtLabel.Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", Rim_Elev="
        If Not Trim(txtRim_Elev.Text) = "" Then
            sUpdate = sUpdate + """" + Trim(txtRim_Elev.Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
    
        sUpdate = sUpdate + ", Const_Date="
        If Not Trim(txtConst_Date.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtConst_Date].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", Orig_Date="
        If Not Trim(txtOrig_Date.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtOrig_Date].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", ABAN_Date="
        If Not Trim(txtAban_Date.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtAban_Date].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", [Sect_NO]="
        If Not Trim(txtSect_NO.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtSect_NO].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", Plat="
        If Not Trim(txtPlat.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtPlat].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", Owner="
        If Not Trim(cboOwner.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([cboOwner].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
           
        sUpdate = sUpdate + ", Inflow_1="
        If Not Trim(txtInflow_1.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtInflow_1].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
      
        sUpdate = sUpdate + ", Inflow_4="
        If Not Trim(txtInflow_4.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtInflow_4].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
    
        sUpdate = sUpdate + ", INFL_INV5="
        If Not Trim(txtINFL_INV5.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtINFL_INV5].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
        
        sUpdate = sUpdate + ", INFL_DIR5="
        If Not Trim(txtINFL_DIR5.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtINFL_DIR5].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
    
    sUpdate = sUpdate + " where MSLink = " + lblMSLinkID.Caption
    Set obj1 = New Class1
    obj1.dynExecute = sUpdate
    Set obj1 = Nothing
    
    'Here I need to loop through all connected pipes and assign the label and things like that
    
    Dim oenumerator As ElementEnumerator
    Dim ele As Element
    
    Set oenumerator = ActiveModelReference.GetSelectedElements
    Dim EleCount As Integer
    Dim CellElement As CellElement
    EleCount = 0
    Do While oenumerator.MoveNext
       Set ele = oenumerator.Current
       If ele.IsCellElement Then
            Set CellElement = ele
        End If
    Loop
        
    CellOrigin = CellElement.Origin
    
        Dim USlabel As String
        Dim DSlabel(2) As String
        Dim USMSLINKID As String
        Dim DSMslinkID(2) As String
        Dim CurrentOUTPipeMSLINKID(2) As String
        Dim CurrentINPipeMSLINKID(5) As String
        Set obj1 = New Class1
              
            'FIRST THE OUTFLOWS....
            If Trim(txtOutflow_1.Text) <> "" And Trim(txtOutflow_1.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET US_LABEL = '" & txtLabel.Text & "', US_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtOutflow_1.Text) & ")"
            End If
            
            If Trim(txtOutflow_2.Text) <> "" And Trim(txtOutflow_2.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET US_LABEL = '" & txtLabel.Text & "', US_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtOutflow_2.Text) & ")"
            End If
            
            'Now the INFLOWS....
            If Trim(txtInflow_1.Text) <> "" And Trim(txtInflow_1.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_1.Text) & ")"
            End If
            
            If Trim(txtInflow_2.Text) <> "" And Trim(txtInflow_2.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_2.Text) & ")"
            End If
            
            If Trim(txtInflow_3.Text) <> "" And Trim(txtInflow_3.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_3.Text) & ")"
            End If
            
            If Trim(txtInflow_4.Text) <> "" And Trim(txtInflow_4.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_4.Text) & ")"
            End If
            
            If Trim(txtInflow_5.Text) <> "" And Trim(txtInflow_5.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_5.Text) & ")"
            End If
            
    
    Set obj1 = Nothing
    glbResponse = 1
    
    End Sub

  14. #14
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Quote Originally Posted by EssKayKay View Post
    Ellis Dee -

    I've been trying to post the code for CheckForZero() and UpdateSanMan() functions but appears they won't go through. They are both very long (150+ lines each). I'll try posting separatly.
    CheckForZero turns out to be irrelevant to our purposes, but it does demonstrate poor coding practices. See how it's a single block of code repeated a half-dozen times? You should never have repetitive code blocks, but instead move that code block into a function and then call that function repeatedly. After doing so, CheckForZero() reduces to:
    vb Code:
    1. Private Sub CheckForZero()
    2.     txtRim_Elev.Text = PadZero(txtRim_Elev.Text)
    3.     txtOUTFL_INV1.Text = PadZero(txtOUTFL_INV1.Text)
    4.     txtOUTFL_INV2.Text = PadZero(txtOUTFL_INV2.Text)
    5.     txtINFL_INV1.Text = PadZero(txtINFL_INV1.Text)
    6.     txtINFL_INV2.Text = PadZero(txtINFL_INV2.Text)
    7.     txtINFL_INV3.Text = PadZero(txtINFL_INV3.Text)
    8.     txtINFL_INV4.Text = PadZero(txtINFL_INV4.Text)
    9.     txtINFL_INV5.Text = PadZero(txtINFL_INV5.Text)
    10. End Sub
    11.  
    12. Private Function PadZero(ByVal pstrText As String) As String
    13.     Dim lngPos As Long
    14.    
    15.     If Trim(Len(pstrText)) > 2 Then
    16.         lngPos = InStr(1, pstrText, ".", 1)
    17.         If lngPos <> 0 Then
    18.             If Mid(Right(pstrText, 3), 1, 1) <> "." Then
    19.                 pstrText = pstrText & "0"
    20.             End If
    21.         Else
    22.             pstrText = pstrText & ".00"
    23.         End If
    24.     End If
    25.     PadZero = pstrText
    26. End Function
    As you can see, this code is much tighter. Also of note is that you shouldn't use "+" to concatenate strings, but rather "&".

    None of this matters to you for what you need doing. I just can't help myself pointing out stuff like this.

  15. #15
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Quote Originally Posted by EssKayKay View Post
    Here's the second. The code was too long so I had to eliminate some of it - I believe it demonstates what's happening.
    This is the code we need. Note again how it's just a long, repetitive group of identical code blocks. I find this type of coding incredibly grating, and not just because it makes it more difficult to post to messageboards when you need help. This function would reduce to about the same length as the CheckForZero() reduces to if we had any desire to tighten it up. I'm guessing the entire project has this issue, and that the whole project could be cut to around a third of its current size with only a few hours worth of work. And that smaller version would be much easier to maintain. But that's totally beside the point.

    Anyway, all we want to do is cancel the button click if the LABEL field would be a duplicate value. Right? I mean, if it's a duplicate should other stuff happen? Like, should certain buttons become enabled/disabled or should textboxes get automatically cleared or something? That's your call; let me know.

    Back on topic, it looks like the LABEL field gets set to the contents of txtLabel.Text, so this should be a piece of cake. Here's what we know:

    Table name: SAN_MH
    Field name: Label
    New value: Trim(txtLabel.Text)
    Database: ??? (Either DAO or ADO. Probably ADO.)

    The key to finding out if it's using DAO or ADO is in the actual code that executes the SQL statement this function spends countless repetive code blocks setting up. That code is found here:
    Code:
    Set obj1 = New Class1
    obj1.dynExecute = sUpdate
    Set obj1 = Nothing
    You can either right-click dynExecute and choose Definition to find that function, or just open the "Class1" class (terrible name, btw) and look for the dynExecute subroutine. (Almost certainly a Public Sub, but could be a function.)

    Post the contents of that function and hopefully we'll be all set.

  16. #16

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I totally agree with all you said regarding the repetitive coding. This project was developed by a consultant. At that time, I knew nothing about VBA (still know very little). I don’t want to mess with it too much. I could cause more problems than I atempt to fix – I think you understand. In a perfect world, I’d have access to a seasoned programmer such as yourself.

    Code:
    Public Property Let dynExecute(ByVal sSQL As String)
    On Error GoTo HandleError
        Dim cmd1 As New ADODB.Command
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
        Set cmd1 = Nothing
    HandleError:
        If (Err.Number <> 0) Then
            MsgBox (Err.Description)
        End If
    End Property
    Thanks again,
    Steve

  17. #17

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I just replaced the old CheckForZero function with your recommendations and it works perfect.

    Thanks again,
    SKK

  18. #18
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Here's the generic function to see if a given label is a duplicate. This needs to be put in Class1 despite how much I loathe that generic name. (Was clsADO or even clsData too difficult a name to come up with? Sheesh.)
    vb Code:
    1. Public Function LabelExists(ByVal pstrLabel As String) As Boolean
    2.     Dim rst As ADODB.Recordset
    3.     Dim strSQL As String
    4.    
    5.     strSQL = "SELECT LABEL FROM SAN_MH WHERE LABEL = '" & pstrLabel & "';"
    6.     Set rst = New ADODB.Recordset
    7.     rst.Open strSQL, cn1, adOpenStatic, adLockReadOnly
    8.     LabelExists = Not rst.EOF
    9.     rst.Close
    10.     Set rst = Nothing
    11. End Function
    I've been going back and forth on whether we need a wrapper function to call the above lookup. I vote yes. Because accessing the data involves instancing a class,the extra layer of abstraction will be helpful. Add the following function to any bas module; you can even create a new one to put it in if you like. (If you list the names of the bas modules in the project I can probably recommend which one makes the most sense.)
    vb Code:
    1. Public Function CheckForDuplicates(pstrLabel As String) As Boolean
    2.     Dim cls As Class1
    3.  
    4.     Set cls = New Class1
    5.     CheckForDuplicates = cls.LabelExists(pstrLabel)
    6.     Set cls = Nothing
    7. End Function
    And finally, we need to change the command button's click event to check for duplicates before it does anything else.
    vb Code:
    1. Private Sub cmdUpdate_Click()
    2. If CheckForDuplicates(txtLabel.Text) Then
    3.     MsgBox "Duplicate Label found", vbInformation, "Notice"
    4. Else
    5.     cmdDone.Visible = False
    6.     cmdCancel.Visible = True
    7.    
    8.     If cmdUpdate.Tag = "Edit" Then
    9.         UnLockForm_SanMan
    10.         cmdUpdate.Caption = "Update"
    11.         cmdUpdate.Tag = "Update"
    12.     Else
    13.         CheckForZero
    14.         UpdateSanMan
    15.         ScanDrawingRemoveSANMANText
    16.         CommandState.StartPrimitive New clsPlaceSanTextNode
    17.         LockForm_SanMan
    18.         cmdUpdate.Tag = "Edit"
    19.         cmdUpdate.Caption = "Edit"
    20.         cmdDone.Visible = True
    21.         cmdCancel.Visible = False
    22.         Unload frmSanMH
    23.         frmSanitary.SHOW
    24.     End If
    25. End If
    This may not be the entire fix only in that there may be a little housecleaning left to do from a user interface perspective. My first question is, after making the above changes does trying to add a duplicate label leave anything enabled or disabled that shouldn't be? Like, for example, the Update button itself getting disabled would be bad.

    The sceond consideration is what would the user normally do after trying to add a duplicate? I'm guessing they'd want to re-enter a new District or Manhole, right? If so, it is a courtesy to move the focus back to that control. This would look like:
    vb Code:
    1. If CheckForDuplicates(txtLabel.Text) Then
    2.     MsgBox "Duplicate Label found", vbInformation, "Notice"
    3.     With txtDistrict
    4.         .SetFocus
    5.         .SelStart = 0
    6.         .SelLength = Len(.Text)
    7.     End With
    8. Else
    I just guessed the name of the textbox; you'd have to change it as appropriate.

    Let me know if you have trouble with any of this. I'm happy to answer any further questions.
    Last edited by Ellis Dee; Feb 9th, 2010 at 08:11 PM.

  19. #19

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I've been pulled from that project for a bit (working on our sidewalk DB now) but hopefully will get back to it later this week. I'll keep you posted.

    Thanks again for your time,
    Steve

  20. #20

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,
    I'm back.....

    1. Copied Public Function LabelExists() into Class1
    2. I’m a bit confused on where to put the CheckForDuplicates() function. The project has three parts - Forms, Modules, and Class Modules (see attached screen shot). I’m assuming Modules.
    3. Modified cmdUpdate_Click and added your code.
    4. Added the If CheckForDuplicates (txtLabel.txt) Then to end of cmdUpdateClick

    When I run the routine, it bombs after clicking the EDIT button with:

    Compile error:
    Variable not defined

    Highlighting “cnn” on line:
    rst.Open strSQL, cnn, adOpenStatic, adLockReadOnly

    Now maybe I have these placed in the wrong location.

    Thanks,
    SKK
    Attached Images Attached Images  

  21. #21
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Oops, sorry for the typo. cnn should be cn1

    The CheckForDuplicates() function can either go in the same form where the command button is, or you can put it in Module1. It's written as a generic helper function, and as such is generically more appropriate for Module1. Then again, it's really only going to be called inside the form, so it could go there as well.

    I'd probably end up putting it in the form, right after the Click() event code just to keep things together. If you do this, I'd change the "Public Function" line to "Private Function", since it'll only ever be called from inside the form.
    Last edited by Ellis Dee; Feb 9th, 2010 at 08:14 PM.

  22. #22

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I’m still seeing a few issues with the process. I believe I forgot to mention something else that’s quite important (again - mea culpa). The routine’s form is used for both linking new CAD elements or editing existing linked elements.

    When I open the form, the cmdUpdate button is captioned EDIT. When I click Edit, the button’s caption should change to UPDATE. However, at the time, the “Duplicate Label found” message box appears and the routine bypasses the update. Maybe if we could test for duplicate record after the UPDATE button is clicked (in other words, prior to committing the record), we’d be OKAY.

    Now maybe some of this is because I placed the code incorrectly.

    1. I placed the Public Function CheckForDuplicates in Module1. When I tried it in the form’s code location, it bombed.
    2. I substituted/placed your cmdUpdate code under Private Sub cmdUpdate_Click
    3. I placed the “CheckForDuplicates(txtLabel.Text) Then” code after the cmdUpdate_Click code.
    4. When I run this on an existing linked element, I never see the UPDATE button.
    5. So, it tried removing the first test (If CheckForDuplicates(txtLabel.Text) Then) and only have it located at the end of the cmdUpdate routine (see attached). This worked better in that at least the cmdUpdate caption changed to UPDATE. However, it still displayed the “Duplicate Label found” message. I could continue with my editing. However, when I clicked UPDATE the “Duplicate Label” message still appears even if the label truly is unique.
    6. After #5 above, when I click OK on Duplicate Label message box, I receive a Run-time error 2110 – Can’t move focus because it is invisible, not enabled, or type that does not accept focus. It bombs on the .SetFocus line under If CheckForDuplicates. I tried remarking it out and it appears to be fine. However, if the label truly is a duplicate, it still places the text. Here’s where if it finds a duplicate label, I want the routing to simply exit.

    I hope this didn’t get too convoluted. I realize without being familiar with CAD or our data, this can be confusing. If this is getting too involved and you wish to drop it, I totally understand. However, it seems like you’re really close.

    Again, thanks for your time and consideration. I really do appreciate it.
    Steve Kipping

    Code:
    Private Sub cmdUpdate_Click()
    '===== add by SKK per Ellis Dee's recommendations on vbforms.com =====
    
    'If CheckForDuplicates(txtLabel.Text) Then
    '    MsgBox "Duplicate Label found", vbInformation, "Notice"
    'Else
        cmdDone.Visible = False
        cmdCancel.Visible = True
        
        If cmdUpdate.Tag = "Edit" Then
            UnLockForm_SanMan
            cmdUpdate.Caption = "Update"
            cmdUpdate.Tag = "Update"
        Else
            CheckForZero
            UpdateSanMan
            ScanDrawingRemoveSANMANText
            CommandState.StartPrimitive New clsPlaceSanTextNode
            LockForm_SanMan
            cmdUpdate.Tag = "Edit"
            cmdUpdate.Caption = "Edit"
            cmdDone.Visible = True
            cmdCancel.Visible = False
            Unload frmSanMH
            frmSanitary.SHOW
        End If
    'End If
    
    '-----------
       If CheckForDuplicates(txtLabel.Text) Then
           MsgBox "Duplicate Label found", vbInformation, "Notice"
           With txtDistrict
               '.SetFocus
               .SelStart = 0
               .SelLength = Len(.Text)
           End With
       Else
       End If
    End Sub

  23. #23

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    Since my last post, the more I dig into this the tougher it gets. What’s happening is when editing the current record, if the label does not change, I don’t want to see the Duplicate Label message – only if the label changes (i.e., changes to a label that already exists).

    I don’t know if this is possible but is there a way to simply test for the MS Access error that’s displayed if duplicate record appears when the LABEL field’s index property is set to No Duplicates (see attached)? If the error message appears exit the routine.

    If you think this is doable, I game, otherwise, I think I’m going to throw in the towel.

    Your thoughts are very welcome,
    SKK
    Attached Images Attached Images  

  24. #24
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Quote Originally Posted by EssKayKay View Post
    I’m still seeing a few issues with the process. I believe I forgot to mention something else that’s quite important (again - mea culpa). The routine’s form is used for both linking new CAD elements or editing existing linked elements.

    When I open the form, the cmdUpdate button is captioned EDIT. When I click Edit, the button’s caption should change to UPDATE. However, at the time, the “Duplicate Label found” message box appears and the routine bypasses the update. Maybe if we could test for duplicate record after the UPDATE button is clicked (in other words, prior to committing the record), we’d be OKAY.
    I'm aware that the button is used for multiple purposes; I referred to the two purposes upthread as "tag states" because whenever you click the button, the contents of the Tag property determine what the current purpose of the button is. I mentioned this in passing in this post, meaning you shouldn't think this is some new thing that makes the problem suddenly harder. I could tell immediately that this would probably be an issue.

    I need a little more detail about how it's supposed to work on a conceptual level, forgetting the code for a minute. What exactly is the difference between EDIT and UPDATE? What is the user doing when he clicks the EDIT version of the button, and what is he doing when he clicks the UPDATE version?

    Also, you mention wanting something else to happen when we fail due to the label field being a duplicate. Typically, whenever data entry fails validation, nothing at all happens and the user is allowed to change their faulty data. This is pretty much a universal truth, not just for this application. Explain in a little more detail what state should change when a duplicate is found. Why shouldn't the user be simply changing the label to something unique? Note that I'm not saying what you are asking for is wrong. Simply that I do not understand.

  25. #25
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Quote Originally Posted by EssKayKay View Post
    I don’t know if this is possible but is there a way to simply test for the MS Access error that’s displayed if duplicate record appears when the LABEL field’s index property is set to No Duplicates (see attached)? If the error message appears exit the routine.

    If you think this is doable, I game, otherwise, I think I’m going to throw in the towel.
    Absolutely possible. This was actually my very first recommendation, back in post #2.

    If you want to go with this approach instead, revert the command button's click even to to the original version as posted upthread by you. Then read and follow the instructions in post #2.

    You posted the function that uses a MsgBox command to display the "duplicate was found..." error message upthread:
    Code:
    Public Property Let dynExecute(ByVal sSQL As String)
    On Error GoTo HandleError
        Dim cmd1 As New ADODB.Command
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
        Set cmd1 = Nothing
    HandleError:
        If (Err.Number <> 0) Then
            MsgBox (Err.Description)
        End If
    End Property

  26. #26

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I’ve been attempting to find where the code specified in Post #2 (On Error GoTo cmdAddErr) exists. I assumed it would be under the Private Sub cmdUpdate_Click but its not there. I tried adding it but I still only see “MicroStation” in the blue bar of the Duplicate Values error box.

    I really wish I could be of more help but I think you're seeing my lack of knowlege.

    Thanks again,
    SKK

  27. #27

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    Just one more note. I placed numerous MsgBox"#" throughout the code to find where does the MicroStation Duplicate Label error occur. It appears to be triggered in the UpdateSanMan() function between the following lines:

    After: Set obj1 = New Class1
    Before: obj1.dynExecute = sUpdate

    Not sure if that sheds any light on the problem. If not, like I said, maybe its time you wish to call it quits.

    Thanks again,
    SKK


    Code:
    Private Sub UpdateSanMan()
    
    Dim sUpdate As String
         sUpdate = "update SAN_MH set Label ="
        
        If Not Trim(txtLabel.Text) = "" Then
            sUpdate = sUpdate + """" + Trim(txtLabel.Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
                
        sUpdate = sUpdate + ", INFL_DIR5="
        If Not Trim(txtINFL_DIR5.Text) = "" Then
            sUpdate = sUpdate + """" + Trim([txtINFL_DIR5].Text) + """"
        Else
            sUpdate = sUpdate + "NULL"
        End If
    
    
    sUpdate = sUpdate + " where MSLink = " + lblMSLinkID.Caption
    Set obj1 = New Class1
        ‘Here’s where the MicroStation Duplicate Label error will occur…..
        MsgBox “1”
    obj1.dynExecute = sUpdate
        MsgBox “2”
    Set obj1 = Nothing
    
    
    
    'Here I need to loop through all connected pipes and assign the label and things like that
    
    Dim oenumerator As ElementEnumerator
    Dim ele As Element
    
    Set oenumerator = ActiveModelReference.GetSelectedElements
    Dim EleCount As Integer
    Dim CellElement As CellElement
    EleCount = 0
    Do While oenumerator.MoveNext
       Set ele = oenumerator.Current
       If ele.IsCellElement Then
            Set CellElement = ele
        End If
    Loop
        
    CellOrigin = CellElement.Origin
    
        Dim USlabel As String
        Dim DSlabel(2) As String
        Dim USMSLINKID As String
        Dim DSMslinkID(2) As String
        Dim CurrentOUTPipeMSLINKID(2) As String
        Dim CurrentINPipeMSLINKID(5) As String
        Set obj1 = New Class1
              
            'FIRST THE OUTFLOWS....
            If Trim(txtOutflow_1.Text) <> "" And Trim(txtOutflow_1.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET US_LABEL = '" & txtLabel.Text & "', US_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtOutflow_1.Text) & ")"
            End If
            If Trim(txtOutflow_2.Text) <> "" And Trim(txtOutflow_2.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET US_LABEL = '" & txtLabel.Text & "', US_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtOutflow_2.Text) & ")"
            End If
            
            'Now the INFLOWS....
            If Trim(txtInflow_1.Text) <> "" And Trim(txtInflow_1.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_1.Text) & ")"
            End If
            If Trim(txtInflow_2.Text) <> "" And Trim(txtInflow_2.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_2.Text) & ")"
            End If
            If Trim(txtInflow_3.Text) <> "" And Trim(txtInflow_3.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_3.Text) & ")"
            End If
            If Trim(txtInflow_4.Text) <> "" And Trim(txtInflow_4.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_4.Text) & ")"
            End If
            If Trim(txtInflow_5.Text) <> "" And Trim(txtInflow_5.Text) <> "0" Then
                obj1.dynExecute = "UPDATE SAN_PIPE SET DS_LABEL = '" & txtLabel.Text & "', DS_MANHOLE = '" & lblMSLinkID.Caption & "' " & _
                " Where((mslink) = " & Trim(txtInflow_5.Text) & ")"
            End If
            
    
    Set obj1 = Nothing
    glbResponse = 1
    
    End Sub
    Last edited by EssKayKay; Feb 11th, 2010 at 11:26 AM.

  28. #28
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Can't find the function? I posted it in my last post and highlighted the msgbox line. It starts with the line:

    Public Property Let dynExecute(ByVal sSQL As String)

    I understand that you aren't an experienced programmer so I'm trying to lead you by the hand. I can't get any more explictly detailed than I did in my previous post; you have to meet me halfway.

  29. #29

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I understand your frustration and I apologize for taking so much of your time. I’m going to abandon my attempt to fix this. The user will just have to be more cautious when entering manhole labels.

    I truly do appreciate your time and consideration. You were more than gracious. Hopefully next time I will be more helpful in my explanations. Again, thank you very much.

    Good Bye for now,
    Steve Kipping

  30. #30
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    I don't understand why you want to abandon this, nor why you can't find where in the code the msgbox is. I highlighted the line. Do you not see it in my post?

  31. #31
    PowerPoster Spoo's Avatar
    Join Date
    Nov 2008
    Location
    Right Coast
    Posts
    2,656

    Re: Check for duplicate records

    Steve

    I've been following this thread off and on, and am sorry to see
    you conclude to abandon your attempt to fix things.

    I would vote in favor of making your app "idiot proof" (ie, NOT relying
    on the user to be more cautious). This seems to be an issue of
    "user input error trapping", which is an ideal function of an app.

    However, I must confess to being a newbie when it comes to Classes.
    I'll have to get up to speed on that matter, and read more carefully
    the prior posts. But I hope that you will ultimately be able to enable
    your app to do the desired "user input error trapping."

    Spoo

  32. #32

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    OKAY Guys let's try this again.

    Ellis,
    I believe I did what you noted in Post #2. I assume we are looking for cmdUpdated_Click function. There was no error checking in that code. So I added code as I think should be (I separated what I added between ------- lines - see attached).

    However, when I update a record with a purposely duplicate label, I’m still seeing “MicroStation” in the blue bar on top rather than an error number. So, maybe I’m placing this code incorrectly.

    I'm taking this one step at a time - this should be what exits after Post #2.

    Thanks,
    SKK


    Code:
    Private Sub cmdUpdate_Click()
    
    '------ added by SKK ------
    On Error GoTo cmdUpdateErr
    '-------------------------------
    
    cmdDone.Visible = False
    cmdCancel.Visible = True
    
    If cmdUpdate.Tag = "Edit" Then
        UnLockForm_SanMan
        cmdUpdate.Caption = "Update"
        cmdUpdate.Tag = "Update"
    Else
        CheckForZero
        UpdateSanMan
        ScanDrawingRemoveSANMANText
        CommandState.StartPrimitive New clsPlaceSanTextNode
        LockForm_SanMan
        cmdUpdate.Tag = "Edit"
        cmdUpdate.Caption = "Edit"
        cmdDone.Visible = True
        cmdCancel.Visible = False
        Unload frmSanMH
        frmSanitary.SHOW
    End If
    
    '------ added by SKK ------
    cmdUpdateExit:
        Exit Sub
    
    cmdUpdateErr:
        MsgBox Err.Description, vbInformation, Err.Number
        Resume cmdUpdateExit
     '-------------------------------
    
    End Sub
    Last edited by EssKayKay; Feb 11th, 2010 at 03:43 PM.

  33. #33

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis or Spoo,

    Any ideas on what I may have done wrong with the coding in Post #32? I was hoping to see the error number but still only see "MicroStation" in the blue heading.

    I'll be out of the office on Monday but will return on Tuesday.

    Thanks again and have a good weekend,
    SKK

  34. #34
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Re-read post 25. I'm not sure why you assumed the function with the MsgBox you want is cmdUpdate_Click, nor why you went looking through the entire project. I told you outright exactly where it is in post 25. I even posted the whole function (dynExecute) and highlighted the MsgBox line in yellow.

    I'm happy to help you finish this change. I don't consider helping people on a programming message board a waste of time at all. But I have a sinking feeling that you stopped reading my posts. How else could you not know where the MsgBox line is? I highlighted it in yellow.

  35. #35

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    I believe I’m getting really close. I found the error message number (-2147467259) by modifying the code in the dynExecute property in the Class1 Class Module (see below). However, if the “Duplicate Label” message appears, how do I exit the routine? Currently if I purposely enter a duplicate label, after clicking OK on the error message box, it continues on with the routine, thus placing a duplicate label. What I’d like is to simply stop processing.

    Code:
    Public Property Let dynExecute(ByVal sSQL As String)
    On Error GoTo HandleError
        Dim cmd1 As New ADODB.Command
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
        Set cmd1 = Nothing
    HandleError:
        'If (Err.Number <> 0) Then
        If Err.Number = -2147467259 Then
            'MsgBox (Err.Description)
            MsgBox "Duplicate Label exits - please re-enter..."
        End If
    End Property
    Again, thanks
    SKK

  36. #36
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    First we need to re-enable the msgbox for other unexpected errors, so change that error handler to this:
    Code:
    Public Property Let dynExecute(ByVal sSQL As String)
    On Error GoTo HandleError
        Dim cmd1 As New ADODB.Command
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
        Set cmd1 = Nothing
    HandleError:
        Select Case Err.Number
            Case 0 ' Nothing wrong, no message
            Case -2147467259: MsgBox "Duplicate Label exits - please re-enter..."
            Case Else: MsgBox Err.Description
        End Select
    End Property
    The next part is tricky. What we really need to do is return a value from this function identifying whether or not we ran into an error. Sadly, this isn't a function; it's a property. Properties have no return value. Instead, they have property Get functions. But you can't send a Property Get a parameter, like in this example a SQL statement.

    Unless there is already a property get? Do a search in Class1 for:

    Property Get dynExecute

    I doubt you'll find one; this class design is wacky as heck, and the fact that it's named Class1 doesn't inspire confidence either.

    If there is no property get, our best best is to simply create our own routine. Copy this code right next to dynExecute in Class1:
    Code:
    Public Function dynExecuteSQL(ByVal pstrSQL As String) As Boolean
    On Error GoTo dynExecuteSQLErr
        Dim cmd1 As New ADODB.Command
    
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
    
    dynExecuteSQLExit:
        Set cmd1 = Nothing
        Exit Function
        
    dynExecuteSQLErr:
        dynExecuteSQL = True
        Select Case Err.Number
            Case -2147467259: MsgBox "Duplicate Label exits - please re-enter..."
            Case Else: MsgBox Err.Description
        End Select
        Resume dynExecuteSQLExit
    End Function
    More instructions to follow, but first, did you find a Property Get?

  37. #37

    Thread Starter
    Junior Member
    Join Date
    Feb 2010
    Posts
    24

    Re: Check for duplicate records

    Ellis,

    Nope did not find "Property Get dynExecute"

    Following is what I copied/modified (both in the Class Modules - Class1).

    Code:
    Public Property Let dynExecute(ByVal sSQL As String)
    'added per Ellis Dees suggestion on vbforms.net 02-02-2010
    
    On Error GoTo HandleError
        Dim cmd1 As New ADODB.Command
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
        Set cmd1 = Nothing
    HandleError:
        ''If (Err.Number <> 0) Then
        'If Err.Number = -2147467259 Then
            ''MsgBox (Err.Description)
            'MsgBox "Duplicate Label exits - please re-enter..."
        'End If
        
        Select Case Err.Number
            Case 0 ' Nothing wrong, no message
            Case -2147467259: MsgBox "Duplicate Label exits - please re-enter..."
            Case Else: MsgBox Err.Description
        End Select
    End Property
    
    
    
    Public Function dynExecuteSQL(ByVal pstrSQL As String) As Boolean
    'added per Ellis Dees suggestion on vbforms.net 02-02-2010
    
    On Error GoTo dynExecuteSQLErr
        Dim cmd1 As New ADODB.Command
    
        Set cmd1.ActiveConnection = cn1
        cmd1.CommandText = sSQL
        cmd1.Execute
    
    dynExecuteSQLExit:
        Set cmd1 = Nothing
        Exit Function
        
    dynExecuteSQLErr:
        dynExecuteSQL = True
        Select Case Err.Number
            Case -2147467259: MsgBox "Duplicate Label exits - please re-enter..."
            Case Else: MsgBox Err.Description
        End Select
        Resume dynExecuteSQLExit
    End Function
    Thanks,
    SKK

  38. #38
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Just a thought, you might consider removing my name from the code and just putting a link to this thread in there. I only mention this because my name is an unprofessional joke name that becomes obvious when you say it out loud.
    Last edited by Ellis Dee; Feb 18th, 2010 at 01:07 PM.

  39. #39
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    Re: Check for duplicate records

    Okay, in the UpdateSanMan() function you posted, the block of code that adds the duplicate is listed as:
    Code:
    sUpdate = sUpdate + " where MSLink = " + lblMSLinkID.Caption
    Set obj1 = New Class1
        ‘Here’s where the MicroStation Duplicate Label error will occur…..
        MsgBox “1”
    obj1.dynExecute = sUpdate
        MsgBox “2”
    Set obj1 = Nothing
    We need to connect this to the new function you just added. This new function returns the error state: TRUE if there's an error, FALSE if successful. If there's an error, we will bail on the rest of the UpdateSanMan function. To achieve this, change the above code to this:
    Code:
    sUpdate = sUpdate + " where MSLink = " + lblMSLinkID.Caption
    Set obj1 = New Class1
    If obj1.dynExecuteSQL(sUpdate) Then
        ' Error adding to table (probably a duplicate Label)
        Set obj1 = Nothing
        Exit Sub
    End If
    Set obj1 = Nothing
    This should get us most of the way home, but I believe we still have a little cleanup left. This cleanup will involve changing UpdateSanMan from a Sub to a Function so it can return a value to cmdUpdate_Click().

    Note: Remove any and all new error handling you put into the code except for the code I had you add. I mean from like cmdUpdate_Click, UpdateSanMan, etc...
    Last edited by Ellis Dee; Feb 18th, 2010 at 01:10 PM.

  40. #40
    PowerPoster Spoo's Avatar
    Join Date
    Nov 2008
    Location
    Right Coast
    Posts
    2,656

    Re: Check for duplicate records

    Quote Originally Posted by Ellis Dee View Post
    I only mention this because my name is an unprofessional joke name that becomes obvious when you say it out loud.
    After all this time, I just got it

    Spoo

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width