VCS_Reference.bas 2.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182
  1. Option Compare Database
  2. Option Private Module
  3. Option Explicit
  4. ' Import References from a CSV, true=SUCCESS
  5. Public Function ImportReferences(ByVal obj_path As String) As Boolean
  6. Dim fso As Object
  7. Dim InFile As Object
  8. Dim line As String
  9. Dim item() As String
  10. Dim GUID As String
  11. Dim Major As Long
  12. Dim Minor As Long
  13. Dim filename As String
  14. Dim refName As String
  15. filename = dir$(obj_path & "references.csv")
  16. If Len(filename) = 0 Then
  17. ImportReferences = False
  18. Exit Function
  19. End If
  20. Set fso = CreateObject("Scripting.FileSystemObject")
  21. Set InFile = fso.OpenTextFile(obj_path & filename, iomode:=ForReading, create:=False, Format:=TristateFalse)
  22. On Error GoTo failed_guid
  23. Do Until InFile.AtEndOfStream
  24. line = InFile.readline
  25. item = Split(line, ",")
  26. If UBound(item) = 2 Then 'a ref with a guid
  27. GUID = Trim$(item(0))
  28. Major = CLng(item(1))
  29. Minor = CLng(item(2))
  30. Application.References.AddFromGuid GUID, Major, Minor
  31. Else
  32. refName = Trim$(item(0))
  33. Application.References.AddFromFile refName
  34. End If
  35. go_on:
  36. Loop
  37. On Error GoTo 0
  38. InFile.Close
  39. Set InFile = Nothing
  40. Set fso = Nothing
  41. ImportReferences = True
  42. Exit Function
  43. failed_guid:
  44. If err.number = 32813 Then
  45. 'The reference is already present in the access project - so we can ignore the error
  46. Resume Next
  47. Else
  48. MsgBox "Failed to register " & GUID, , "Error: " & err.number
  49. 'Do we really want to carry on the import with missing references??? - Surely this is fatal
  50. Resume go_on
  51. End If
  52. End Function
  53. ' Export References to a CSV
  54. Public Sub ExportReferences(ByVal obj_path As String)
  55. Dim fso As Object
  56. Dim OutFile As Object
  57. Dim line As String
  58. Dim ref As Reference
  59. Set fso = CreateObject("Scripting.FileSystemObject")
  60. Set OutFile = fso.CreateTextFile(obj_path & "references.csv", overwrite:=True, Unicode:=False)
  61. For Each ref In Application.References
  62. If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
  63. If Not ref.BuiltIn Then
  64. line = ref.GUID & "," & CStr(ref.Major) & "," & CStr(ref.Minor)
  65. OutFile.WriteLine line
  66. End If
  67. Else
  68. line = ref.FullPath
  69. OutFile.WriteLine line
  70. End If
  71. Next
  72. OutFile.Close
  73. End Sub