Verwijzingen automatisch inschakelen wanneer database start

[Joffertje]

Ik heb een database geprogrammeerd waarin ik andere verwijzingen gebruik dan de standaard.
Nu wil ik graag dat deze ingeschakeld worden wanneer ik de database start, en weer uitgeschakeld word wanneer ik de database afsluit.

Ik kan nergens vinden of dit mogelijk is, en als het mogelijk is, hoe ik dat in VBA moet maken.
Weet iemand of het mogelijk is?
En als het mogelijk is, heeft iemand een idee hoe de vba code is?

 

[OctaFish]

Ik heb een database geprogrammeerd waarin ik andere verwijzingen gebruik dan de standaard.

Leg eerst eens uit wat je bedoelt; op basis van jouw vraag lijkt het mij stug als er iemand een idee heeft welke VBA commando's je nodig hebt.

 

[Joffertje]

O... dacht dat het wel duidelijk was, sorry.

Ik heb in mijn database meerdere verwijzingen gebruikt, anders dan de verwijzingen die standaard aangevinkt zijn.
Deze kan je aan en uitzetten in het VBA programmacode scherm (Access starten, database laden, dan [ALT]-[F11], dan [Extra], [Verwijzingen])
Bekijk bijlage 185233
Nu wil ik graag dat de verwijzingen, die niet aangevinkt zijn, aangevinkt worden wanneer ik de database start.
Wanneer ik de database afsluit moeten ze weer uitgevinkt worden.

Ik weet niet zeker of dit mogelijk is, dat was mijn eerste vraag.

Als dit mogelijk is, zou ik graag willen weten hoe deze code er dan uitziet in VBA.
Ik heb het geprobeert met het "GetUserName" script aan te passen, maar dat was geen succes.

Ik wil graag dat deze verwijzingen automatisch worden aan- en uitgevinkt omdat deze database door meerdere collega's wordt gebruikt en ik anders bij deze langs moet gaan om de verwijzingen aan te zetten.

 

[OctaFish]

Graag de code met terugwerkende kracht (Bericht bewerken, en CODE knop gebruiken voor de code) opmaken als code. Zo is hij nogal lastig te lezen. En graag met de ingesprongen lussen natuurlijk...

 

[OctaFish]

Voor zover ik weet worden bibliotheken (want daar heb je het toch over?) al in de database zelf opgeslagen; er is dus geen enkele reden om ze op die manier te laden en te verwijderen. Da's één. En punt twee: als je de bibliotheken niet hebt staan bij de gebruiker, kunnen ze ook niet geladen worden. Dan heeft een aparte routine ook geen zin. En drie: volgt eigenlijk uit twee: wil je er zeker van zijn dat alle functies werken, ongeacht of de gebruiker de bibliotheek heeft of niet, laad ze dan met Late Binding en niet met Early Binding. Dan hoef je nooit meer iets aan of uit te zetten.

 

[Joffertje]

Tsja....
'Tis voor mij ook allemaal nieuw he...

Het gaat niet om het laden van de verwijzingen, maar het aan- en uitvinken (wel- of geen vinkje voor de verwijzing).
bijvoorbeeld.

in mijn database gebruik ik de verwijzing "microsoft ADO Ext. 2.8 for DDL and Security".
Standaard staat deze niet aangevinkt.
Wanneer een collega deze database gaat gebruiken krijgt hij allerlei foutmeldingen omdat de verwijzing niet aangevinkt staat.
Nu wil ik ervoor zorgen dat, wanneer de database start, het vinkje word aangezet en weer wordt uitgezet wanneer ik hem weer uitzet.​

Nu praat jij over late binding en early binding...
Daar heb ik nog nooit van gehoort, ga ik even checken...

Option Compare Database

Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0 'De Functie aanroep is succesvol

Option Explicit

Function GetUsername() As String

[INDENT]Dim LUserName As String
Const lpnLength As Integer = 255
Dim status As Integer
Dim lpName

' Assign the buffer size constant to lpUserName.
LUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, LUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
[INDENT]
LUserName = Left$(LUserName, InStr(LUserName, Chr(0)) - 1)
[/INDENT]
Else
' An error occurred.
[INDENT]
MsgBox "Unable to get the name."
End
[/INDENT]
End If

GetUsername = LUserName
[/INDENT]

End Function

 

[OctaFish]

Het gaat niet om het laden van de verwijzingen, maar het aan- en uitvinken (wel- of geen vinkje voor de verwijzing).

En wat is denk je het verschil?
Je code ziet er nu een stuk beter uit; mag die weg in de vorige draad lijkt mij. Ik heb al genoeg problemen met scrollarmpjes
En over code gesproken:

Function GetUserName() As String
    GetUserName= VBA.Environ("Username")
End Function

Meer heb je niet nodig.

 

[OctaFish]

Wie wat bewaard die heeft wat... Ik gebruik voor een project in Excel een routine die de bibliotheken naloopt en al dan niet uitzet of toevoegt. Die bleek simpel te converteren naar Access. Het gaat om de volgende 3 procedures:

Function ListReferences()
Dim refCurr As Reference

  For Each refCurr In Application.References
    Debug.Print refCurr.Name & ": " & refCurr.FullPath & " - " & refCurr.Guid
  Next

End Function

Deze functie print alle verwijzingen die je in de huidige db hebt staan. Je hebt daarvan ofwel de GUID, ofwel de Fullpath waarde van nodig.

Function AddReference()
'Add a VBA Reference Library via code
'Macro purpose:  To add a reference to the project using the GUID for the reference library
Dim strGUID As String, strFile As String
Dim theRef As Variant
Dim i As Long

    'Update the GUID you need below, or use the Filename reference
    strGUID = "{00000600-0000-0010-8000-00AA006D2EA4}"
    strFile = "C:\Program Files\Common Files\System\ado\msadox.dll"
     
     'Set to continue in case of error
    On Error Resume Next
     'Remove any missing references
    With Application.References
            For i = .Count To 1 Step -1
                Set theRef = .Item(i)
                If theRef.IsBroken = True Then .Remove theRef
            Next i
         'Clear any errors so that error trapping for GUID additions can be evaluated
        Err.Clear
         'Add the reference from File
         .AddFromFile strFile
         'Add the reference from GUID
        ''.AddFromGuid Guid:=strGUID, Major:=1, Minor:=0
    End With
     
     'If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         'Reference already in use.  No action necessary
    Case Is = vbNullString
         'Reference added without issue
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine & "add or remove a reference in this file" _
            & vbNewLine & "Please check the " & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Function

Deze functie laadt de opgegeven bibliotheek. Zoals je ziet, moet hij wel bestaan op de opgegeven locatie. Je zou daar een netwerkdrive o.i.d. voor kunnen gebruiken, waar je alle bibliotheken in zet. Je verwijst dan specifiek naar de netwerklocatie.

Function DeleteReference()
'Delete a VBA Reference Library via code
'Macro purpose:  To add a reference to the project using the GUID for the reference library
Dim strGUID As String, strFile As String
Dim theRef As Variant
Dim i As Long

    'Update the GUID you need below, or use the Filename reference
    strGUID = "{00000600-0000-0010-8000-00AA006D2EA4}"
    strFile = "C:\Program Files\Common Files\System\ado\msadox.dll"
     
     'Set to continue in case of error
    On Error Resume Next
    With Application.References
        For i = .Count To 1 Step -1
            Set theRef = .Item(i)
            'Remove Reference based on GUID or Fullpath
            If theRef.FullPath = strFile Then .Remove theRef
            ''If theRef.Guid = strGUID Then .Remove theRef
        Next i
        Err.Clear
    End With
     
     'If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         'Reference already in use.  No action necessary
    Case Is = vbNullString
         'Reference added without issue
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine & "add or remove a reference in this file" _
            & vbNewLine & "Please check the " & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Function

En hiermee kun je de verwijzingen weer verwijderen.

 

[Joffertje]

Hey Michel,

Allereerst even een opmerking voor wat betreft de code "GetUsername"
Wij gebruiken hier op mijn werk office 2003, volgens mij kan het dan niet verkort.

Bedankt voor de code, ik ben ermee aan het freubelen geweest en in mijn database ingepast.
Met de code "ListReferences" laat ik een tabel vullen die ik bij "AddReference" en "deleteReference" weer uitlees om de verwijzingen in- of uit te schakelen.

Function ListReferences()
Dim refCurr As Reference

    Dim strReferenties As String
    
    DoCmd.SetWarnings False
    'Tabel leegmaken (gereedmaken voor opnieuw vullen)
    DoCmd.RunSQL "DELETE VERWIJZINGEN.VERWFILE, VERWIJZINGEN.VERWNM, VERWIJZINGEN.VERWGUID FROM VERWIJZINGEN;"
    DoCmd.SetWarnings False
  
  For Each refCurr In Application.References
    Debug.Print refCurr.Name & ": " & refCurr.FullPath & " - " & refCurr.Guid
    strReferenties = strReferenties & vbCrLf & refCurr.Name
    DoCmd.SetWarnings False
    'Tabel vullen met verwijzingen die nodig zijn
    DoCmd.RunSQL "INSERT INTO VERWIJZINGEN ( VERWFILE, VERWNM, VERWGUID ) SELECT '" & refCurr.FullPath & "' AS VERWFILE, '" & refCurr.Name & "' AS VERWNM, '" & refCurr.Guid & "' AS VERwGUID;"
    DoCmd.SetWarnings False
  Next

    MsgBox strReferenties, vbOKOnly, "REFERENTIES IN DATABASE"
End Function

Met de code "AddReference" lees ik deze tabel weer uit zodat ik alleen de nodige refences inschakel.

Function AddReference()
    'Add a VBA Reference Library via code
    'Macro purpose:  To add a reference to the project using the GUID for the reference library
    Dim strGUID As String, strFile As String
    Dim theRef As Variant
    Dim i As Long
    Dim rstOutput As Recordset
    
    Set rstOutput = CurrentDb.OpenRecordset("VERWIJZINGEN")

   ' Enumerate the specified Recordset object.
    With rstOutput
        Do While Not .EOF
         strGUID = .Fields("[VERWGUID]").Value
         strFile = .Fields("[VERWFILE]").Value
         'Set to continue in case of error
        On Error Resume Next
         'Remove any missing references
        With Application.References
            For i = .Count To 1 Step -1
                Set theRef = .Item(i)
                If theRef.IsBroken = True Then .Remove theRef
            Next i
             'Clear any errors so that error trapping for GUID additions can be evaluated
            Err.Clear
             'Add the reference from File
             '.AddFromFile strFile
             'Add the reference from GUID
            .AddFromGuid Guid:=strGUID, Major:=1, Minor:=0
        End With
        .MoveNext
      Loop
    End With
     
     'If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         'Reference already in use.  No action necessary
    Case Is = vbNullString
         'Reference added without issue
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine & "add or remove a reference in this file" _
            & vbNewLine & "Please check the " & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Function

Met de code "DeleteRaference" ben ik nog aan het stoeien, hij valt in een oneindige loop volgnes mij.
Maar daar kom ik uiteindelijk ook wel uit denk ik.
Ik ieder geval ben ik ontzettend geholpen met je code.

Function DeleteReference()
'Delete a VBA Reference Library via code
'Macro purpose:  To add a reference to the project using the GUID for the reference library
Dim strGUID As String, strFile As String
Dim theRef As Variant
Dim i As Long
    Dim rstOutput As Recordset
    
    Set rstOutput = CurrentDb.OpenRecordset("VERWIJZINGEN")

   ' Enumerate the specified Recordset object.
    With rstOutput
        Do While Not .EOF
        strGUID = .Fields("[VERWGUID]").Value
        strFile = .Fields("[VERWFILE]").Value
        'Set to continue in case of error
        On Error Resume Next
        With Application.References
            For i = .Count To 1 Step -1
                Set theRef = .Item(i)
                'Remove Reference based on GUID or Fullpath
                'If theRef.FullPath = strFile Then .Remove theRef
                If theRef.Guid = strGUID Then .Remove theRef
            Next i
            Err.Clear
        End With
        Loop
    End With
         
     'If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         'Reference already in use.  No action necessary
    Case Is = vbNullString
         'Reference added without issue
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine & "add or remove a reference in this file" _
            & vbNewLine & "Please check the " & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Function

 

[OctaFish]

Ik gebruik ook Office 2003 op het werk, met dus Environ("UserName"). En zonder problemen. Ik heb in de voorbeeldcode VBA.Environ gezet, omdat de code anders in 2007/2010 niet werkt. In 2003 kun je Environ("UserName") gebruiken. Ik heb de Reference code bij mij uitgetest (op een 2003 db) en daar doet-ie het prima zonder oneindige lus.

 

[Joffertje]

Dat wist ik niet...
Alweer wat bijgeleerd!

Bedankt!