[AccessD] References

Hi William,

I know we spoke about References a short while back. Below is a Class which
may help you.
It has two functions, one to export a list of references and the other to
re-create references from that exporting list.
Basically, when you have everthing working ok in an mdb you should export
the References to the text  file.
The next time you create a new mdb and don't want to have to manually
re-create or select the References  you can just use the second  function to
create them for you.
The import will also import any references that are found in specific files
and thus you can modularise your references to suit different MDBs.

HTH

Max



Option Compare Database
Option Explicit
Sub TestReferences()
    Dim var As Variant
    Dim clsRef As New clsReferences
    var = clsRef.libExportReferencesToTextFile ' export them
    var = clsRef.libImportReferencesFromTextFile ' import them
End Sub

' clsReference - max.wanadoo at gmail.com 19 March 2010.
Option Compare Database
Option Explicit

Public Function libExportReferencesToTextFile(Optional
strReferenceFilesFileNameDefault As String = "References.txt")
  On Error GoTo EH
  Close  ' close any open files
  Dim strReferenceFiles As String, strSourceFileName As String, strMsg As
String
  Dim pIntFile As Integer, Ref As Reference, bFound As Boolean, strMissing
As String, strReferences
  strSourceFileName = CurrentProject.path & "\" &
strReferenceFilesFileNameDefault

  strReferenceFiles = "EXPORT REFERENCE FILES:" & vbCrLf
  strMissing = "MISSING: " & vbCrLf

  For Each Ref In References
    'Debug.Print Ref.Name, Ref.FullPath, Ref.IsBroken
    If Ref.IsBroken = True Then
      strMissing = strMissing & "  -  " & Ref.FullPath & " (" & Ref.Name &
")" & vbCrLf
    Else
      strReferenceFiles = strReferenceFiles & "  -  " & Ref.FullPath & " ("
& Ref.Name & ")" & vbCrLf
      strReferences = strReferences & Ref.FullPath & vbCrLf
    End If
  Next

  ' output the results.
  pIntFile = FreeFile
  Open strSourceFileName For Output As pIntFile
  Print #pIntFile, strReferences
  Close pIntFile

EX:
  If Not strMissing = "MISSING: " & vbCrLf Then
    strMissing = strMissing & "Missing Files are NOT Listed in the Export
Reference File just created."
  End If
  strMsg = strReferenceFiles & vbCrLf & strMissing
  MsgBox strMsg
  Set Ref = Nothing
  Close  ' close any open files
  Exit Function
EH:
  Select Case Err.Number
  Case Else
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    Resume Next
  End Select
  Resume EX
End Function


Public Function libImportReferencesFromTextFile(Optional
strReferencesFileNameDefault As String = "References.txt")
' this function will try to LOAD as a Reference all items listed in ANY file
in the currentproject.path folder
' where the filename starts with "Reference" and ends in ".txt"
' this means that to load differing sets of Reference based on differing
circumstances, you have  only
' to place the text  file in this folder  with the name like
"Reference*.txt",
' replacing * with a number or letter  or whateve.
' eg. ReferenceBasic.txt, ReferenceStock.txt, ReferencesOCX.txt, etc
  On Error GoTo EH
  Close  ' close any open files
  Dim strReference As String, strSourceFolder As String, strSourceFileName
As String
  Dim strReferenceFiles As String, strReferences As String
  Dim strMissing As String, strErrs As String, strAlreadyloaded As String,
strNewlyLoaded As String
  Dim pIntFile As Integer, bFound As Boolean
  strSourceFolder = CurrentProject.path & "\"
  strSourceFileName = Dir(strSourceFolder, vbNormal)

  strReferenceFiles = "IMPORT REFERENCE FILES:" & vbCrLf
  strMissing = "MISSING: " & vbCrLf
  strAlreadyloaded = "ALREADY LOADED:" & vbCrLf
  strNewlyLoaded = "NEWLY LOADED: " & vbCrLf

  While (Len(strSourceFileName) > 0)
    If Left(strSourceFileName, 9) = "Reference" And Right(strSourceFileName,
4) = ".txt" Then
      strReferenceFiles = strReferenceFiles & "  -  " & strSourceFileName &
vbCrLf
      pIntFile = FreeFile
      Open strSourceFolder & strSourceFileName For Input As pIntFile
      Do While Not EOF(pIntFile)
        Line Input #pIntFile, strReference
        If Len(Trim(strReference)) > 0 Then
          Debug.Print strReference
          If InStr(strReference, "Missing") > 0 Then
            strMissing = strMissing & "  -  " & strReference & vbCrLf
          Else
            bFound = True
            References.AddFromFile strReference
            If bFound = True Then
              strNewlyLoaded = strNewlyLoaded & "  -  " & strReference &
vbCrLf
            End If
          End If
        End If
      Loop
      Close pIntFile
    End If
    strSourceFileName = Dir
  Wend
  If strReferenceFiles = "IMPORT REFERENCE FILES:" & vbCrLf Then
    strReferenceFiles = strReferenceFiles & vbCrLf & "  -  No Reference
Files found" & vbCrLf
  End If
EX:
  strReferenceFiles = strReferenceFiles & vbCrLf & strNewlyLoaded & vbCrLf &
strMissing & vbCrLf & strAlreadyloaded & vbCrLf & strErrs
  MsgBox strReferenceFiles
  Close  ' close any open files
  Exit Function
EH:
  Select Case Err.Number
  Case 53
    strErrs = strErrs & "Input File Missing - Aborting (" &
strSourceFileName & ")"
    Resume EX
  Case 32813
    ' This is expected for the basic references that Access loads itself and
any others already loaded.
    strAlreadyloaded = strAlreadyloaded & "  -  " & strReference & vbCrLf
    bFound = False
    Resume Next
  Case 29060
    strMissing = strMissing & "  -  " & strReference & vbCrLf
    bFound = False
    Resume Next
  Case Else
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    Resume Next
  End Select
  Resume EX
End Function