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

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.

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 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..

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

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

Quote:

---

Originally Posted by EssKayKay

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.

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

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.

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

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.

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

---

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

---

Quote:

---

Originally Posted by EssKayKay

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:

Private Sub CheckForZero()
    txtRim_Elev.Text = PadZero(txtRim_Elev.Text)
    txtOUTFL_INV1.Text = PadZero(txtOUTFL_INV1.Text)
    txtOUTFL_INV2.Text = PadZero(txtOUTFL_INV2.Text)
    txtINFL_INV1.Text = PadZero(txtINFL_INV1.Text)
    txtINFL_INV2.Text = PadZero(txtINFL_INV2.Text)
    txtINFL_INV3.Text = PadZero(txtINFL_INV3.Text)
    txtINFL_INV4.Text = PadZero(txtINFL_INV4.Text)
    txtINFL_INV5.Text = PadZero(txtINFL_INV5.Text)
End Sub
 
Private Function PadZero(ByVal pstrText As String) As String
    Dim lngPos As Long
    
    If Trim(Len(pstrText)) > 2 Then
        lngPos = InStr(1, pstrText, ".", 1)
        If lngPos <> 0 Then
            If Mid(Right(pstrText, 3), 1, 1) <> "." Then
                pstrText = pstrText & "0"
            End If
        Else
            pstrText = pstrText & ".00"
        End If
    End If
    PadZero = pstrText
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.

Quote:

---

Originally Posted by EssKayKay

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.

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

Ellis,

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

Thanks again,
SKK

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:

Public Function LabelExists(ByVal pstrLabel As String) As Boolean
    Dim rst As ADODB.Recordset
    Dim strSQL As String
    
    strSQL = "SELECT LABEL FROM SAN_MH WHERE LABEL = '" & pstrLabel & "';"
    Set rst = New ADODB.Recordset
    rst.Open strSQL, cn1, adOpenStatic, adLockReadOnly
    LabelExists = Not rst.EOF
    rst.Close
    Set rst = Nothing
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:

Public Function CheckForDuplicates(pstrLabel As String) As Boolean
    Dim cls As Class1
 
    Set cls = New Class1
    CheckForDuplicates = cls.LabelExists(pstrLabel)
    Set cls = Nothing
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:

Private Sub cmdUpdate_Click()
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

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:

If CheckForDuplicates(txtLabel.Text) Then
    MsgBox "Duplicate Label found", vbInformation, "Notice"
    With txtDistrict
        .SetFocus
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
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.

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

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

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.

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

---

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

Quote:

---

Originally Posted by EssKayKay

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.

Quote:

---

Originally Posted by EssKayKay

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

---

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

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

---

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.

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

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?

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

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

---

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

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.

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

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?

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

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.

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...

Quote:

---

Originally Posted by Ellis Dee

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 :wave:

Spoo

Ellis,

How unobservant of me – I love it (similar to my EssKayKay but much better).

After keying in any label (duplicate or not) and clicking Update, I receive an error:

“Compile error: variable not defined”
on “Public Function dynExecuteSQL(ByVal pstrSQL As String) As Boolean”

I believe I have removed all my error handling.


Following is what/how I modified the code:

Code:

---

sUpdate = sUpdate + " where MSLink = " + lblMSLinkID.Caption
Set obj1 = New Class1
   
    'Here's where the MicroStation Duplicate Error will occur (between MsgBox 1 & 2)
    'MsgBox "1"
'obj1.dynExecute = sUpdate
    'MsgBox "2"

'--- added per vbforms 02-18-2010 ----
If obj1.dynExecuteSQL(sUpdate) Then
    ' Error adding to table (probably a duplicate Label)
    Set obj1 = Nothing
    Exit Sub
End If
'-------------------------------------

Set obj1 = Nothing

---

Where Error occurs:

Code:

---

Public Function dynExecuteSQL(ByVal pstrSQL As String) As Boolean
'added per 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

Oops, sorry, my bad. Another typo. Change the highlighted line as shown:

Code:

---

Public Function dynExecuteSQL(ByVal pstrSQL As String) As Boolean
'added per suggestion on vbforms.net 02-02-2010

On Error GoTo dynExecuteSQLErr
    Dim cmd1 As New ADODB.Command

    Set cmd1.ActiveConnection = cn1
    cmd1.CommandText = pstrSQL
    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

---

Got it - no errors, BUT if I keyin a duplicate label, after clicking OK on the Duplicate Error message box, it proceeds to place the manhole info box with the duplicate label. I was hoping it would simple exit the procedure.

SKK

Depending on the definition of simple, it is. It's easier than what we've already done, for example.

Note that you said you didn't want it to just do nothing. That's why the CheckForDuplicates() method was rejected; there was some other logic you wanted to have happen. Now is probably a good time for you to explain in detail what that other logic is. If you aren't sure what I mean, we can identify it through trial and error.

In the meantime, change the UpdateSanMan() Sub to a Function by changing this line...

Code:

---

Private Sub UpdateSanMan()

---

...to this...

Code:

---

Private Function UpdateSanMan() As Boolean

---

Then inside UpdateSanMan in the same place as before add the highlighted line:

Code:

---

'--- added per vbforms 02-18-2010 ----
If obj1.dynExecuteSQL(sUpdate) Then
    ' Error adding to table (probably a duplicate Label)
    Set obj1 = Nothing
    UpdateSanMan = True
    Exit Function
End If
'-------------------------------------

---

Once that's in place we can begin the trial and error as necessary. (The "Exit Sub" line should change itself to "Exit Function" automatically.)

The first trial will be the simplest, just exiting on an error. After implemeting the changes from the previous post, everything else will be handled in cmdUpdate_Click(). Make the following change and see how it suits your needs:

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
    If UpdateSanMan() Then Exit Sub
    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 Sub

---

I guess I shouldn’t have used the word “simply” as I realize nothing’s that easy.

I’m very sorry if I said I didn’t want it to do nothing (most definitely a misstatement). If it encounters a duplicate label, after displaying the Duplicate Record message, that’s exactly what I want it to do – nothing (other than possibly closing the input form).

I changed Private Sub UpdateSanMan() to
Private Function UpdateSanMan() As Boolean
and added the line UpdateSanMan = True

But it’s still placing a manhole info box with duplicate label data after clicking OK on the Duplicate Error message box.

SKK

SKK

Did you also make the change to Private Sub cmdUpdate_Click()
that Ellis Dee suggested in Post #45?

I'm sure he'll call you on this too (!!), but my guess is that
the change he suggested will cause you to exit that sub
prior to "adding the manhole" to your database.

Spoo

Spoo - it looks like that did it (I need be much more observant) - thanks

Ellis - I think you have it. I'm going to play with this more tomorrow but it works so far. The real test will be when I try to replicate this for storm sewer manholes. The routine is very similar to sanitary so hopefully all goes well. I’ll keep you posted.

Thank you very much for all your time and effort on assisting me with this – I am very appreciative. As I’m sure you noticed how clueless I am with this (and my lack correspondence skills). This will be most helpful with maintaining our data integrity.

Again, thanks for everything,
Steve Kipping
City of Manitowoc
Engineering

I'm happy to help.

I can tell you right now there's a decent chance that adding duplicate storm sewers will probably not reflect our new logic. The good news is that we've already done the heavy lifting by creating the necessary method in Class1 (dynExecuteSQL) and changed UpdateSanMan from a sub to a function. In all likelihood the only thing you'll need to do is identify which command button click event is firing and alter it as in post 45. In other words, change one line and that's it. (Probably; I offer no guarantees! heh.)

Quote:

---

Originally Posted by EssKayKay

I’m very sorry if I said I didn’t want it to do nothing (most definitely a misstatement). If it encounters a duplicate label, after displaying the Duplicate Record message, that’s exactly what I want it to do – nothing (other than possibly closing the input form).

---

That's what the original change did, the one where we added CheckForDuplicates(). In response to that you said:

Quote:

---

Originally Posted by EssKayKay

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 never really understood this, but in fairness to you I recognize that the dual-functionality of the Update button adds extra complexity to the user interface logic. I probably should have pressed this point further, but hindsight is 20/20. There is nothing inherently wrong about the approach we ended up going with.

Be sure to test it out and verify the user interface is reacting correctly to all scenarios. eg: When it's a dupe it does what you want, when it's not a dupe it does what you want, and both hold true for when it's an update button and when it's an edit button.

I wouldn't be surprised if there were some minor user interface tweaking you still want/need to do. I'm happy to stick with it until you get everything squared away.

Well Ellis, I updated the storm manhole routine to function similar to the sanitary and all appears fine. I threw every scenario at it I could think of and it worked great. The real test though will be when I install it on other user’s machines (they work with this stuff much more than I). Hopefully all goes well.

So, again, thank you very much for all your time and effort. Like I said, it truly is appreciated.

Goodbye for now and please take care,
SKK

Unfortunately Ellis I cannot give you any rep at the moment but this thread is exactly why I visit this forum. You have inspired me.

BTW I never picked up on the name either. Guess you have to spell it out to some people but it's a good one. :)