VBA : liste de toutes les références disponibles (activées ou non)

[dionys0s]

Bonjour le forum,

tout est dans le titre. J'aurais aimé savoir s'il était possible d'obtenir la liste de toutes les références disponibles.

Lorsqu'on parcourt les références d'un projet, on n'obtient malheureusement que celles qui sont déjà activées.

D'avance merci pour votre aide

 

[dionys0s]

Oui, c'est ce que je voulais signifier...

 

[Dranreb]

Mais je n'ai rien vu de ce genre dans le classeur que vous aviez joint.

 

[Dranreb]

J'ai essayé ça, qui marche à peu près dans un UserForm muni d'une ListBox à ColumnCount = 3:

Private Sub UserForm_Initialize()
   RefList ListBox1
   End Sub

En modifiant comme suit la Sub RefList :

Public Sub RefList(ByVal LBx As MSForms.ListBox)

  Dim R1 As Long, R2 As Long
  Dim hHK1 As Long, hHK2 As Long
  Dim hHK3 As Long, hHK4 As Long
  Dim Row As Long, Index As Long
  Dim lpPath As String, lpGUID As String
  Dim lpName As String, lpDescription As String
  Dim T()

  Let Application.ScreenUpdating = False
  Let Application.Calculation = xlCalculationManual

  Call Cells.Clear
  Let lpPath = String$(128, vbNullChar)
  Let lpDescription = String$(128, vbNullChar)
  Let lpName = String$(128, vbNullChar)
  Let lpGUID = String$(128, vbNullChar)
  Let R1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, "TypeLib", ByVal 0&, KEY_READ, hHK1)
 
  If R1 = ERROR_SUCCESS Then
   ReDim T(1 To 3, 1 To 10000)
    Do While Not R1 = ERROR_NO_MORE_ITEMS
      Let R1 = RegEnumKey(hHK1, Row, lpGUID, Len(lpGUID))
      If R1 = ERROR_SUCCESS Then
        Let R2 = RegOpenKeyEx(hHK1, lpGUID, ByVal 0&, KEY_READ, hHK2)
        If R2 = ERROR_SUCCESS Then
          Let Index = 0
          Do While Not R2 = ERROR_NO_MORE_ITEMS
            Let R2 = RegEnumKey(hHK2, Index, lpName, Len(lpName))
            If R2 = ERROR_SUCCESS Then
              Call RegQueryValue(hHK2, lpName, lpDescription, Len(lpDescription))
              Call RegOpenKeyEx(hHK2, lpName, ByVal 0&, KEY_READ, hHK3)
              Call RegOpenKeyEx(hHK3, "0", ByVal 0&, KEY_READ, hHK4)
              Call RegQueryValue(hHK4, "win32", lpPath, Len(lpPath))
              Let Index = Index + 1
              Let Row = Row + 1
              Let T(1, Row) = lpGUID
              Let T(2, Row) = lpDescription
              Let T(3, Row) = lpPath
            End If
          Loop
        End If
      End If
      Let Row = Row + 1
    Loop
    Call RegCloseKey(hHK1)
    Call RegCloseKey(hHK2)
    Call RegCloseKey(hHK3)
    Call RegCloseKey(hHK4)
  End If
ReDim Preserve T(1 To 3, 1 To Row)
LBx.List = WorksheetFunction.Transpose(T)
End Sub

 

[dionys0s]

Re,
je vais regarder votre réponse. En attendant voici le classeur plus complet avec les deux classes.
Toutefois, je sais d'avance que je souhaiterai me passer de UserForm. L'idée finale, c'est d'avoir uniquement une liste des descriptions des références à vérifier, avec les numéros de version remplacés par une astérisque, et rien d'autre. Et quand le classeur s'ouvre, il vérifie qu'elles sont bien activées. Et si elles ne le sont pas, il va les chercher dans la liste des références disponibles pour les ajouter (VBProject.References.AddFromFile(FilePath)).

 

[dionys0s]

Re,

j'ai trouvé une solution, sans vraiment savoir si c'est fiable à 100% (mais fiable sur les références testées) :

Au moment d'ajouter un nouvel item dans mes références, au lieu de ça :

Call AvailableReferences.Add(lpDescription, lpPath, lpGUID)

je fais ceci :

Call AvailableReferences.Add( _
  Left(lpDescription, InStr(1, lpDescription, vbNullChar) - 1), _
  Left(lpPath, InStr(1, lpPath, vbNullChar) - 1), _
  Left(lpGUID, InStr(1, lpGUID, vbNullChar) - 1))

 

[eriiic]

Bonjour,

en fait tu as 2 chaines accolées, la 2nde en unicode :

              i = InStr(lpDescription, Chr(0))
              lpDesc2 = StrConv(Mid(lpDescription, i), vbFromUnicode)
              MsgBox lpDesc2

eric

 

[dionys0s]

Re,
Bonjour eric,

j'ai essayé, ça ne fonctionne pas...
Tu avais vu mon post #20 ?

 

[Dranreb]

Ça m'avais aussi vaguement effleuré l'esprit que le contenu du String pouvait comporter un vbNullChar marquant la fin de son vrai contenu sans que sa longueur de 128 au départ n'ait été changée. Mais ça explique mal pourquoi il est quand même parfois bien affecté à des String.

 

[eriiic]

Ca veut dire quoi 'ça ne fonctionne pas' ?
J'ai bien la 2nde partie qui ressort correcte :

pour la 1ère tu fais juste un Left(lpDescription, i-1)

Tu peux aussi éliminer le 00 00 de début de la 2nde chaine, c'est peut-être ça qui te gène :
lpDesc2 = StrConv(Mid(lpDescription, i + 2), vbFromUnicode)
Je n'avais pas été jusqu'au contrôle du msgbox, juste regardé les variables...

 

[dionys0s]

Re,

juste un quiproquo eric. Du coup c'est tout bon.
Merci pour votre aide à tous les deux.