openaccess/source/modules/VCS_Relation.bas

Option Compare Database

Option Private Module
Option Explicit


Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
    On Error GoTo err
    Dim fso As Object
    Dim OutFile As Object
    
    Dim relname As String
    relname = rel.name
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, unicode:=False)
    
    OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
    OutFile.WriteLine rel.name
    OutFile.WriteLine rel.table
    OutFile.WriteLine rel.foreignTable
    
    Dim f As DAO.field
    For Each f In rel.Fields
        OutFile.WriteLine "Field = Begin"
        OutFile.WriteLine f.name
        OutFile.WriteLine f.ForeignName
        OutFile.WriteLine "End"
    Next
    
    OutFile.Close

    logger "ExportRelation", "DEBUG", "Relation " & relname & " exported to " & filePath

    Exit Sub
err:
    logger "ImportRelation", "ERROR", "Unable to import relation " & relname & " [" & err.Description & "]"
End Sub

Public Sub ImportRelation(ByVal filePath As String)
    On Error GoTo err
    Dim fso As Object
    Dim InFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, Create:=False, Format:=TristateFalse)
    Dim rel As DAO.Relation
    Set rel = New DAO.Relation

    Dim relname As String
    relname = rel.name

    rel.Attributes = InFile.readline
    rel.name = InFile.readline
    rel.table = InFile.readline
    rel.foreignTable = InFile.readline
    
    Dim f As DAO.field
    Do Until InFile.AtEndOfStream
        If "Field = Begin" = InFile.readline Then
            Set f = New DAO.field
            f.name = InFile.readline
            f.ForeignName = InFile.readline
            If "End" <> InFile.readline Then
                Set f = Nothing
                logger "ImportRelation", "ERROR", "Missing 'End' for a 'Begin' in " & filePath
                GoTo next_rel
            End If
            rel.Fields.Append f
        End If
next_rel:
    Loop
    
    InFile.Close
    
    CurrentDb.Relations.Append rel

    logger "ImportRelation", "DEBUG", "Relation " & relname & " imported from " & filePath

    Exit Sub
err:
    logger "ImportRelation", "ERROR", "Unable to import relation " & relname & " [" & err.Description & "]"
End Sub