scripts to create in memory relationship

Sub Create_Relationship()
Dim oFSO As New Scripting.FileSystemObject
Dim oFS
Dim sText As String
Set oFS = oFSO.OpenTextFile("c:\relation.TXT")
'The text file should contain lines like
'LayerName|TableName|GISFeatureKey|TableKey|RelationshipName|RelationForwardName|RelationBackwardName
'Separated with "|" symbol
Dim myPara As Variant

Dim pMxdoc As IMxDocument
Set pMxdoc = Application.Document
Dim pmap As IMap
Set pmap = pMxdoc.FocusMap

Dim pFtLayer as IFeatureLayer
Dim pStandAloneTab as IStandAloneTable
Do Until oFS.AtEndOfStream
sText = oFS.ReadLine
If sText <> "" Then
myPara = Split(sText, "|")
pFtLayer = FindLayer ( pMap, myPara(0) & "")
pStandAloneTab = FindTable ( pMap, myPara(1) & "" )
if not pFtLayer is nothing and not pStandAloneTab is nothing Then
Create_Memory_Relation pFtLayer, pStandAloneTab, myPara(2) & "", myPara(3) & "", myPara(4) & "", myPara(5) & "", myPara(6) & ""
End If
end if
Loop

End Sub


Function FindLayer ( ByRef pMap as IMap, ByRef strLayerName as String) as IFeatureLayer

Dim pid As New UID

Dim pLayer As ILayer
Dim pEnumLayer As IEnumLayer
pid = "{40A9E885-5533-11d0-98BE-00805F7CED21}" 'IFeatureLayer
Set pEnumLayer = pmap.Layers(pid, True)
pEnumLayer.Reset
Set pLayer = pEnumLayer.Next

Do While Not pLayer Is Nothing
If UCase(pLayer.Name) = UCase(strlayerName) Then
Set FindLayer = pLayer
Exit Function
End If
Set pLayer = pEnumLayer.Next
Loop

FindLayer = Nothing

End Function

Function FindTable ( ByRef pMap as IMap, ByRef strTableName as String) as IStandAloneTable

Dim pStdAloneTabColl As IStandaloneTableCollection
Set pStdAloneTabColl = pMap

Dim pStandaloneTable As IStandaloneTable

For i = 0 To pStdAloneTabColl.StandaloneTableCount - 1
Set pStandaloneTable = pStdAloneTabColl.StandaloneTable(i)
If UCase(pStandaloneTable.Name) = UCase(tableName) Then
FindTable = pStandAloneTable
Exit Function
End if
Next

FindTable = Nothing
End Function


Sub Create_Memory_Relation(ByRef pFeatureLayer as IFeatureLayer, ByRef pStandAloneTable As IStandAloneTable, ByRef strPriKey As String, ByRef strFornKey As String, ByRef strRelName As String, strForward As String, ByRef strBackward As String)

Dim pMemRcFactory As IMemoryRelationshipClassFactory
Dim pMemRc As IRelationshipClass
Set pMemRcFactory = New MemoryRelationshipClassFactory
On Err GoTo errhandler
Set pMemRc = pMemRcFactory.Open(strRelName, pFeatureLayer.FeatureClass, strPriKey, pStandaloneTable.Table, _
strFornKey, strForward, strBackward, esriRelCardinalityOneToMany)

' Add it to the layer.
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pFeatureLayer
If Not pMemRc Is Nothing Then
pRelClassCollEdit.AddRelationshipClass pMemRc
End If

End Sub