VCS_Reference.bas 2.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  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. logger "ImportReferences", "ERROR", "Failed to register " & GUID
  49. Resume go_on
  50. End If
  51. End Function
  52. ' Export References to a CSV
  53. Public Sub ExportReferences(ByVal obj_path As String)
  54. Dim fso As Object
  55. Dim OutFile As Object
  56. Dim line As String
  57. Dim ref As Reference
  58. Set fso = CreateObject("Scripting.FileSystemObject")
  59. Set OutFile = fso.CreateTextFile(obj_path & "references.csv", overwrite:=True, unicode:=False)
  60. For Each ref In Application.References
  61. If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
  62. If Not ref.BuiltIn Then
  63. line = ref.GUID & "," & CStr(ref.Major) & "," & CStr(ref.Minor)
  64. OutFile.WriteLine line
  65. End If
  66. Else
  67. line = ref.FullPath
  68. OutFile.WriteLine line
  69. End If
  70. Next
  71. OutFile.Close
  72. End Sub