VCS_Relation.bas 1.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. Option Compare Database
  2. Option Private Module
  3. Option Explicit
  4. Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
  5. Dim fso As Object
  6. Dim OutFile As Object
  7. Set fso = CreateObject("Scripting.FileSystemObject")
  8. Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
  9. OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
  10. OutFile.WriteLine rel.name
  11. OutFile.WriteLine rel.table
  12. OutFile.WriteLine rel.foreignTable
  13. Dim f As DAO.Field
  14. For Each f In rel.Fields
  15. OutFile.WriteLine "Field = Begin"
  16. OutFile.WriteLine f.name
  17. OutFile.WriteLine f.ForeignName
  18. OutFile.WriteLine "End"
  19. Next
  20. OutFile.Close
  21. End Sub
  22. Public Sub ImportRelation(ByVal filePath As String)
  23. Dim fso As Object
  24. Dim InFile As Object
  25. Set fso = CreateObject("Scripting.FileSystemObject")
  26. Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
  27. Dim rel As DAO.Relation
  28. Set rel = New DAO.Relation
  29. rel.Attributes = InFile.readline
  30. rel.name = InFile.readline
  31. rel.table = InFile.readline
  32. rel.foreignTable = InFile.readline
  33. Dim f As DAO.Field
  34. Do Until InFile.AtEndOfStream
  35. If "Field = Begin" = InFile.readline Then
  36. Set f = New DAO.Field
  37. f.name = InFile.readline
  38. f.ForeignName = InFile.readline
  39. If "End" <> InFile.readline Then
  40. Set f = Nothing
  41. err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filePath
  42. End If
  43. rel.Fields.Append f
  44. End If
  45. Loop
  46. InFile.Close
  47. CurrentDb.Relations.Append rel
  48. End Sub