Excel VBA Data Model Relationships

[wsnyder]

Hi all,
Has anyone tried to use the Objects of the Model Object (Data Model aka Power Pivot)?

I am trying to get a few Properties of the ModelRelationship Object, but I keep getting an error:

Run-time error '1004':
Application-defined or object-defined error

code snippet:

Dim dm As Model
 Dim dmr As ModelRelationship
 For Each dmr In .ModelRelationships
            wsnew.Cells(j, 1).Value = dmr.PrimaryKeyTable
            wsnew.Cells(j, 2).Value = dmr.PrimaryKeyColumn
            wsnew.Cells(j, 3).Value = dmr.ForeignKeyTable
            wsnew.Cells(j, 4).Value = dmr.ForeignKeyColumn
            j = j + 1
        Next dmr


'    With dm
'        i = .ModelRelationships.Count
'        Debug.Print "Relationship Count: " & i
'        j = GetRows(ws:=wsnew) + 1
'        For x = 1 To i
'            wsnew.Cells(j, 1).Value = .ModelRelationships(x).PrimaryKeyTable
'            wsnew.Cells(j, 2).Value = .ModelRelationships(x).PrimaryKeyColumn
'            wsnew.Cells(j, 3).Value = .ModelRelationships(x).ForeignKeyTable
'            wsnew.Cells(j, 4).Value = .ModelRelationships(x).ForeignKeyColumn
'            j = j + 1
'        Next x
'    End With

I tried both looping the collection and by index number, but I get the same error either way.

Thanks
w

 

[Alex Blakenburg]

I can't tell if you are missing declarations and a with statement or whether you have just not included it in your code snippet.

Let's just say the below works, so see if helps with what you are trying to do.

Sub Model_Properties()

    Dim mdl As Model
    Set mdl = ActiveWorkbook.Model

    Dim mrel As ModelRelationship
    'Set mrel = ActiveWorkbook.Model.ModelRelationships(Index:=1)
   
    For Each mrel In mdl.ModelRelationships
        With mrel
            ' if it doesn't exist continue eg no Foreign Key caused error 438
            On Error Resume Next
                Debug.Print .PrimaryKeyTable.Name
                Debug.Print .PrimaryKeyColumn.Name
                Debug.Print .ForeignKeyTable
                Debug.Print .ForeignKeyColumn
            On Error GoTo 0
        End With
   
    Next mrel

End Sub

Mostly based on: Excel class ModelRelationship VBA