VCS_Reference.bas 2.5 KB

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