On Error GoTo - Need Help

[accessNator]

I have a button when clicked, it creates a relationship between two tables. It works fine but if I have a situation where a relationship already exists, I want it to stop and exit. My current code sends a message box that the relationship exist but it does not stop and proceeds to the next line.

I am sure its a simple fix or maybe I should write it a different way. I am giving an example of the same relationship that already exists to test the error, but I need it to stop in its tracks.

Button:

Private Sub cmdCreateRelationships_Click()
    
On Error GoTo Err_cmdCreateRelationships_Click
       
    Me.Repaint
    Me.txtStatus.ForeColor = vbBlue
    Me.txtStatus.Value = "Starting"
    
    On Error Resume Next
    
    ' Create Relationships
    Call CreateRelationships
    ' Use the following line if you want to customize a relationship
    'Call CreateRelationships1

    DoCmd.Beep
            
    Me.Repaint
    Me.txtStatus.ForeColor = vbBlue
    Me.txtStatus.Value = "Finished creating relationships"

Exit_cmdCreateRelationships_Click:
    Exit Sub

Err_cmdCreateRelationships_Click:
    MsgBox Err.description
    Resume Exit_cmdCreateRelationships_Click
End Sub

Private Sub CreateRelationships()
      
    ' tblCompanyInformation => tblContactAgentInformation
    CreateRelationDAO "DaotblCompanyInformation_DaotblContactAgentInformation", "tblCompanyInformation", "tblContactAgentInformation", "company_cid", "agent_cid"
    ' tblCompanyInformation => tblContactAgentInformation
    CreateRelationDAO "DaotblCompanyInformation_DaotblContactAgentInformation", "tblCompanyInformation", "tblContactAgentInformation", "company_cid", "agent_cid"
    ' tblCompanyInformation => tblMiscTransactions
    CreateRelationDAO "DaotblCompanyInformation_DaotblMiscTransactions", "tblCompanyInformation", "tblMiscTransactions", "company_cid", "cid"  
End Sub

Private Sub CreateRelationDAO(passDAORelation As String, passTablePrimary As String, passTableForeign As String, passTableFldPrimary As String, passTableFldForeign)

On Error GoTo Err_CreateRelationshipsDAO
    
    Dim db As DAO.Database
    Dim rel As DAO.Relation
    Dim fld As DAO.Field
    
    'Initialize
    Set db = CurrentDb()
    
    'Create a new relation.
    Set rel = db.CreateRelation(passDAORelation)
    
    'Define its properties.
    With rel
        'Specify the primary table.
        .Table = passTablePrimary
        'Specify the related table.
        .ForeignTable = passTableForeign
        'Specify attributes for cascading updates and deletes.
        .Attributes = dbRelationUpdateCascade + dbRelationDeleteCascade
        
        'Add the fields to the relation.
        'Field name in primary table.
        Set fld = .CreateField(passTableFldPrimary)
        'Field name in related table.
        fld.ForeignName = passTableFldForeign
        'Append the field.
        .Fields.Append fld
        
        'Repeat for other fields if a multi-field relation.
    End With
    
    'Save the newly defined relation to the Relations collection.
    db.Relations.Append rel
    
    'Clean up
    Set fld = Nothing
    Set rel = Nothing
    Set db = Nothing

Exit_CreateRelationshipsDAO:
    Exit Sub

Err_CreateRelationshipsDAO:
    MsgBox Err.description
    Resume Exit_CreateRelationshipsDAO
End Sub

THoughts?

 

[Uncle Gizmo]

I’ve never ensued into this particular area of coding, so I can’t give you a specific answer but I can offer you some general advice.

The first general rule is to avoid generating an error code.

In your case, if it is possible, can you examine the condition of your database programmatically and test to see if the relationship already exists? If the relationship already exists, then do not attempt to create it.

 

[accessNator]

I’ve never ensured into this particular area of coding, so I can’t give you a specific answer but I can offer you some general advice.

The first general rule is to avoid generating an error code.

In your case, if it is possible, can you examine the condition of your database programmatically and test to see if the relationship already exists? If the relationship already exists, then do not attempt to create it.

Uncle Gizmo, Thanks for your reply. I do understand what you are saying. It does test to find that it already exist. I just thought maybe somewhere in my code, I can code something differently to stop my creation the relationship process instead of proceeding.

 

[Uncle Gizmo]

It does test to find that it already exist

I did have a look at the code, and I couldn’t see anywhere it did the test you mention. Please could you point this out to me.

 

[accessNator]

I did have a look at the code, and I couldn’t see anywhere it did the test you mention. Please could you point this out to me.

Example:
In my Sub CreateRelationships
It looks at this line for the second time:

    ' tblCompanyInformation => tblContactAgentInformation
    CreateRelationDAO "DaotblCompanyInformation_DaotblContactAgentInformation", "tblCompanyInformation", "tblContactAgentInformation", "company_cid", "agent_cid"

So it calls the Sub CreateRelationDAO

On the Error GoTo Err_CreateRelationshipsDAO

It proceeds to:
Err_CreateRelationshipsDAO:
MsgBox Err.description
Resume Exit_CreateRelationshipsDAO

Here is where a MsgBox pops up "Object 'DaotblCompanyInformation_DaotblContactAgentInformation' already exist."

It gives OK as my option in my msgbox. Then it proceeds to:
Exit_CreateRelationshipsDAO:
Exit Sub

And goes back to my Sub CreateRelationships

 

[gemma-the-husky]

this bit at the top

On Error GoTo Err_cmdCreateRelationships_Click

Me.Repaint
Me.txtStatus.ForeColor = vbBlue
Me.txtStatus.Value = "Starting"

On Error Resume Next

' Create Relationships

although you originally set the error goto, the second statement just replaces this, by carrying on regardless. this is the problem, i think

 

[accessNator]

I commented the line "On Error Resume Next' but it still continues.

 

[gemma-the-husky]

maybe CreateRelationDAO dopesnt throw an error if it fails.

then the "error" wont get activated

try msgbox(err) after the call to the sub - it will probably just show 0, indicating no trappable error

conversely, if you DO get a unhandled trappable error, it would crash the programme (ie the debug/end msgbox)

 

[Uncle Gizmo]

I think we are all on the same page, there’s just some confusion over the terminology we are using.

The code you are using is relying on something not working, and producing an error code, currently an undefined error code. This means you are up in the air, in a situation in which you have very little control, you are relying on a system produced error code.

The safest way is to actually inspect the relationship, test to see if the relationship actually exists before you try and create it. Not at the actual time you are creating it.

I realize this facility may not be available, or you may have to add it yourself by writing code which loops through the Ordinal values of the relationships.


Alternatively I would consider “deleting” the relationship first, my guess is that if you tried to delete a relationship that didn’t exist, then you would not get an error, so my guess is this would be a safer way, Delete the relationship, and then recreate it.

If you want to continue with the error code route, then I would make the following observations:

If you are going to rely on an error code then when you generate it, or when you think you generated it, you need to report it back, the actual Error code so that you can be sure that you are handling the right code.

If you place a message box in your error routine something like:

Msgbox “ >>> “ & Error.Code & “ >>> “ & Error.Descrption

Correction to the above "Air Code"
Msgbox “ >>> “ & Err.Number & “ >>> “ & Err.Description

And this should report the error code that triggered the Error routine.

 

[gemma-the-husky]

from the point of view of access, if you try to create a realtionship, and it already exists - it can just ignore it, and not throw an error. Why should that be a problem? After the call the relationship exists.

I am sure you will get an error if you specify a non-existent table though - or if the relation cannot be built because some constraint is violated. I certainly wouldnt bother deleting the relationship, just to create it again.

------
its similar to the command to check folder (I am not sure of the exact command offhand) - but I know there is a windows function that creates a path, and all folders in the path, so that at the end of the function the path exists. but If the path ALREADY exists, there is no error.

 

[ghudson]

You should try to avoid using On Error Resume Next.

There should be an error number if there is a runtime error.

Change your error message from MsgBox Err.description to

Exit_cmdCreateRelationships_Click:
    Exit Sub

Err_cmdCreateRelationships_Click:
    [COLOR="Blue"][SIZE="3"]MsgBox [B]Err.number & " - " & Err.description[/B][/SIZE][/COLOR]
    Resume Exit_cmdCreateRelationships_Click
End Sub

Then you can trap for that specific error number if the relationship already exists.

 

[datAdrenaline]

First in foremost, you do realize that you are trying to build the same relationship twice in your "CreateRelationships" code right?

--------

Assuming you did realize that, the second thing I see is will be just reinforcing what Dave (the one with the husky dog named Gemma ) said --- you set the error handler to Resume Next, but fail to handle the condition of Err.Number <> 0, nor do you set it back to Goto <some label>.

But good programming practices favor code that does not rely on reactions to errors in order to branch your program flow --- that technique should be a last resort. With that in mind, you should do as has already been suggested and check to see if the Relationship exists before you attempt to create it. That leaves you with a choice of how you want to determine if you want to look for a duplicate relationship based on the name of the relationship or the actual relationship definition (which tables and keys refer to each other). If you are 100% certain that the only way for the relationship definition to be built is through your code, thus carrying the name that you have given, then a search for the relationship name should be sufficient.

Code to check to see if a relationship exists, based on the name of it, is as follows:

Public Function IsRelationship(strRelationshipName As String _
                               , Optional dbDatabase As DAO.Database)
    Dim db As DAO.Database
    Dim strSQL As String
 
    If dbDatabase Is Nothing Then _
        Set db = CurrentDb
 
    strSQL = "SELECT *" & _
             " FROM MSysRelationships" & _
             " WHERE szRelationship = '" & strRelationshipName & "'"
 
    With db.OpenRecordset(strSQL)
        IsRelationship = Not .EOF
        .Close
    End With
 
End Function

With that code you can place a call to it in a variety of locations, but I would probably do the test BEFORE you call your CreateRelationDAO procedure. Something like this:

Private Sub CreateRelationships()
 
 
    ' tblCompanyInformation => tblContactAgentInformation
    If Not IsRelationship("DaotblCompanyInformation_DaotblContactAgentInformation") Then _
        CreateRelationDAO "DaotblCompanyInformation_DaotblContactAgentInformation" _
                           , "tblCompanyInformation" _
                           , "tblContactAgentInformation" _
                           , "company_cid" _
                           , "agent_cid"
 
    ' tblCompanyInformation => tblMiscTransactions
    If Not IsRelationship("DaotblCompanyInformation_DaotblMiscTransactions") Then _
        CreateRelationDAO "DaotblCompanyInformation_DaotblMiscTransactions" _
                          , "tblCompanyInformation" _
                          , "tblMiscTransactions" _
                          , "company_cid" _
                          , "cid"
 
End Sub

Hope that helps!

 

[accessNator]

http://www.access-programmers.co.uk/forums/member.php?u=14645Uncle Gizmo, gemma-the-husky, ghudson, datAdreneline,

Thank you all for your valuable insight, as a newb at writing vba in access, I knew I had a few things to fix.

datAdreneline, I am going to try your solution. Yes, I purposely wrote it twice in my original post. I just wanted to find a way that if I created a relationship previously, I wanted a way to catch it. I wrote it twice just to test it out.

Thanks all for your assistance. This was pretty cool.