All,



I have attached the Type Library DLL file, which can give you the complete structure of VBA (all Office programs) as well as the resources located in most DLL's, OCX's, and OLB files. It can also give the structure of most installed applications and their executable files.

I personally find this to be extremely helpful, and at this point I've even made my own VBA help system out of it for assistance in writing code. If you're interested, below are the codes that I used to make an Access data structure out of the resources located in system32 DLL's as well as all Microsoft Office libraries. The relevant translations to the VBA language (some are useless) data types from the resulting ''vartypes'' table are:

Code:
vname	vvalue	vreturndatatype	
VT_BOOL	11	Boolean
VT_UI1	17	Byte
VT_CY	6	Currency
VT_DATE	7	Date
VT_R8	5	Double
VT_I2	2	Integer
VT_UI4	19	Long
VT_INT	22	Long
VT_I4	3	Long
VT_NULL	1	NULL
VT_R4	4	Single
VT_BSTR	8	String
VT_VARIANT	12	Variant

The entire operation for these 3 sample directories takes about 30 seconds to execute on a Vista 64-bit machine with a 2.8 GHz dual processor .


Primary Function:
Code:
Public Function ListFiles2() 'This is the only function to be run directly
                           
On Error Resume Next
Call MakeTablesALL

Dim aPaths As Variant

'Office folder, System32 and Common files for installed programs
aPaths = Array( _
   "C:\Program Files (x86)\Microsoft Office\Office12\", _
   "C:\Windows\System32\", _
   "C:\Program Files (x86)\Common Files\")

Dim i As Long
Dim j As Long
Dim strFileSpec As String
Dim bIncludeSubfolders As Boolean

bIncludeSubfolders = True
strFileSpec = ""

    Dim colDirList As New Collection
    Dim varItem As Variant

For j = LBound(aPaths) To UBound(aPaths)

   Call FillDir2(colDirList, aPaths(j), strFileSpec, bIncludeSubfolders)

        For Each varItem In colDirList
         If UCase(CStr(Right(varItem, 3))) = "DLL" Or _
            UCase(CStr(Right(varItem, 3))) = "OCX" Or _
            UCase(CStr(Right(varItem, 3))) = "OLB" Or _
            UCase(CStr(Right(varItem, 3))) = "EXE" Then
            Call CrawlLib(CStr(varItem))
         End If
        Next

   Set colDirList = Nothing

Next j

Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & err.Number & ": " & err.Description
    Resume Exit_Handler
End Function
Called Functions:
Code:
Function MakeTablesALL()

On Error Resume Next

Dim tbl As DAO.TableDef

   For Each tbl In CurrentDb.TableDefs
      If Not tbl.Name = "vartypes" Then
         If Not tbl.Name Like "msys*" Then
            CurrentDb.TableDefs.Delete (tbl.Name)
         End If
      End If
   Next tbl

Dim t As Variant
Dim i As Long

'TABLE NAMES
t = Array("library", "enum", _
          "coclass", "method", _
          "property", , "parameter", _
          "vartypes")

Dim db As DAO.Database
Set db = CurrentDb

For i = LBound(t) To UBound(t)
   Set tbl = db.CreateTableDef(t(i))
     With tbl
         Select Case t(i)
         
            Case "enum"
               .Fields.Append .CreateField("lid", dbLong) 'FK FOR LIBRARY ID
               .Fields.Append .CreateField("eid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("etype", dbText, 255)
               .Fields.Append .CreateField("etypenumber", dbLong) 'TYPE IDENTIFIER IN LIBRARY
               .Fields.Append .CreateField("emember", dbText, 255)
               .Fields.Append .CreateField("evalue", dbText, 255)
               .Fields("eid").Attributes = .Fields("eid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON enum " & _
                           "(eid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError
            
            Case "coclass"
               .Fields.Append .CreateField("lid", dbLong) 'FK FOR LIBRARY ID
               .Fields.Append .CreateField("cid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("ctype", dbText, 255)
               .Fields.Append .CreateField("ctypenumber", dbText, 255)
               .Fields("cid").Attributes = .Fields("cid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON coclass " & _
                           "(cid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError

            Case "method"
               .Fields.Append .CreateField("cid", dbLong) 'FK FOR CLASS ID
               .Fields.Append .CreateField("methodid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("mname", dbText, 255)
               .Fields.Append .CreateField("mreturntype", dbText, 255) 'RETURN TYPE
               .Fields.Append .CreateField("mreturntypenumber", dbText, 255) 'RETURN TYPE NUMBER
               .Fields.Append .CreateField("mreturndatatype", dbText, 255) 'RETURN DATA TYPE, IF APPLICABLE
               .Fields("methodid").Attributes = .Fields("methodid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON method " & _
                           "(methodid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError

            Case "property"
               .Fields.Append .CreateField("cid", dbLong) 'FK FOR CLASS ID
               .Fields.Append .CreateField("propid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("pname", dbText, 255)
               .Fields.Append .CreateField("preturntype", dbText, 255) 'RETURN TYPE
               .Fields.Append .CreateField("preturntypenumber", dbText, 255) 'RETURN TYPE NUMBER
               .Fields.Append .CreateField("preturndatatype", dbText, 255) 'RETURN DATA TYPE, IF APPLICABLE
               .Fields("propid").Attributes = .Fields("propid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON property " & _
                           "(propid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError
            
            Case "parameter"
               .Fields.Append .CreateField("methodid", dbLong) 'FK FOR METHOD ID
               .Fields.Append .CreateField("paramid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("pname", dbText, 255)
               .Fields.Append .CreateField("poptional", dbBoolean)
               .Fields.Append .CreateField("pflags", dbText, 255)
               .Fields.Append .CreateField("pdatatype", dbText, 255)
               .Fields.Append .CreateField("ptype", dbText, 255)
               .Fields.Append .CreateField("ptypenumber", dbText, 255)
               .Fields("paramid").Attributes = .Fields("paramid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON parameter " & _
                           "(paramid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError

            Case "library"
               .Fields.Append .CreateField("lid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("lfile", dbText, 255)
               .Fields.Append .CreateField("lname", dbText, 255)
               .Fields("lid").Attributes = .Fields("lid").Attributes + dbAutoIncrField
                  db.TableDefs.Append tbl
                  strSql = "CREATE INDEX id ON library " & _
                           "(lid) WITH PRIMARY;"
                  db.Execute strSql, dbFailOnError
            
            Case "vartypes"
               .Fields.Append .CreateField("vid", dbLong) 'UNIQUE
               .Fields.Append .CreateField("vname", dbText, 255)
               .Fields.Append .CreateField("vvalue", dbText, 255)
               .Fields("vid").Attributes = .Fields("vid").Attributes + dbAutoIncrField

            Case Else
               'DO NOTHING

         End Select
     End With

Next i

db.Close
Set db = Nothing
Set tbl = Nothing

RefreshDatabaseWindow
End Function


Public Function FillDir2(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    bIncludeSubfolders As Boolean)
    
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    strFolder = TrailingSlash2(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
            For Each vFolderName In colFolders
                Call FillDir2(colDirList, strFolder & TrailingSlash2(vFolderName), strFileSpec, True)
            Next vFolderName
    End If
End Function


Public Function TrailingSlash2(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash2 = varIn
        Else
            TrailingSlash2 = varIn & "\"
        End If
    End If
End Function
Library Crawler Routine:
Code:
Sub CrawlLib(fn As String)

Dim i As Long
Dim temp As String
Dim x As TLI.TypeLibInfo
Dim minfo As TLI.MemberInfo
Dim pinfo As TLI.ParameterInfo
Dim iinfo As TLI.InterfaceInfo
Dim tinfo As TLI.TypeInfo

Dim lid As Long
Dim cid As Long
Dim did As Long
Dim methodid As Long

Dim rs As DAO.Recordset
Dim rsmethods As DAO.Recordset
Dim rsparameters As DAO.Recordset
Dim rsproperties As DAO.Recordset
Set x = TypeLibInfoFromFile(fn)

Set rsmethods = CurrentDb.OpenRecordset("method")
Set rsproperties = CurrentDb.OpenRecordset("property")
Set rsparameters = CurrentDb.OpenRecordset("parameter")

On Error GoTo ExitProc

temp = x.TypeInfos(1).Parent 'IF ERROR, SKIP WRITE PROCESS (no types)

On Error Resume Next

Set rs = CurrentDb.OpenRecordset("library") 'LIB RECORD
   rs.AddNew
   rs!lfile = x.ContainingFile
   rs!lName = x.TypeInfos(1).Parent
      lid = rs!lid
   rs.Update
rs.Close

For Each tinfo In x.TypeInfos

   Select Case tinfo.TypeKindString

      Case "enum" 'ENUMERATION TYPE
         Set rs = CurrentDb.OpenRecordset("enum")
            For Each minfo In tinfo.Members
                  rs.AddNew
                  rs!lid = lid
                  rs![etype] = tinfo.Name
                  rs![etypenumber] = tinfo.TypeInfoNumber
                  rs![emember] = minfo.Name
                  rs![evalue] = minfo.Value
                  rs.Update
            Next minfo
         rs.Close

      Case "coclass" 'COCLASS TYPE
      If Left(tinfo.Name, 1) <> "_" Then
      
         Set rs = CurrentDb.OpenRecordset("coclass")
            rs.AddNew
            rs!lid = lid
            rs!ctype = tinfo.Name
            rs!ctypenumber = tinfo.TypeInfoNumber
               cid = rs!cid
            rs.Update
         rs.Close
            
            For Each iinfo In tinfo.Interfaces
               For Each minfo In iinfo.Members
               
                  If minfo.InvokeKind = 2 Then 'PROPERTY
                     rsproperties.AddNew
                     rsproperties!cid = cid
                     rsproperties![pName] = minfo
                     rsproperties![preturntype] = minfo.ReturnType.TypeInfo.TypeKindString
                     rsproperties![preturntypenumber] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                            Null, _
                                                            minfo.ReturnType.TypeInfoNumber)
                     rsproperties![preturndatatype] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                          minfo.ReturnType.VarType, _
                                                          Null)
                     rsproperties.Update
                  ElseIf minfo.InvokeKind = 1 Then 'METHOD
                     rsmethods.AddNew
                     rsmethods!cid = cid
                     rsmethods![mname] = minfo.Name
                     rsmethods![mreturntype] = minfo.ReturnType.TypeInfo.TypeKindString
                     rsmethods![mreturntypenumber] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                         Null, _
                                                         minfo.ReturnType.TypeInfoNumber)
                     rsmethods![mreturndatatype] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                       minfo.ReturnType.VarType, _
                                                       Null)
                        methodid = rsmethods!methodid
                     rsmethods.Update
                        For Each pinfo In minfo.Parameters
                           rsparameters.AddNew
                           rsparameters!methodid = methodid
                           rsparameters![pName] = pinfo.Name
                           rsparameters![poptional] = pinfo.Optional
                           rsparameters![pflags] = pinfo.Flags
                           rsparameters![pdatatype] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                          Null, _
                                                          pinfo.VarTypeInfo.VarType)
                           rsparameters![pType] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                      pinfo.VarTypeInfo.TypeInfo.TypeKindString, _
                                                      Null)
                           rsparameters![ptypenumber] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                            pinfo.VarTypeInfo.TypeInfoNumber, _
                                                            Null)
                           rsparameters.Update
                        Next pinfo
                  End If
               
               Next minfo
            Next iinfo
      End If

      Case "dispinterface" 'DISPATCH INTERFACE TYPE (use COCLASS table)
      If Left(tinfo.Name, 1) <> "_" Then
      
         Set rs = CurrentDb.OpenRecordset("coclass")
            rs.AddNew
            rs!lid = lid
            rs!ctype = tinfo.Name
            rs!ctypenumber = tinfo.TypeInfoNumber
               cid = rs!cid
            rs.Update
         rs.Close
            For Each iinfo In tinfo.Interfaces
               For Each minfo In iinfo.Members
               
                  If minfo.InvokeKind = 2 Then 'PROPERTY
                     rsproperties.AddNew
                     rsproperties!cid = cid
                     rsproperties![pName] = minfo.Name
                     rsproperties![preturntype] = minfo.ReturnType.TypeInfo.TypeKindString
                     rsproperties![preturntypenumber] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                            Null, _
                                                            minfo.ReturnType.TypeInfoNumber)
                     rsproperties![preturndatatype] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                          minfo.ReturnType.VarType, _
                                                          Null)
                     rsproperties.Update
                  ElseIf minfo.InvokeKind = 1 Then 'METHOD
                     rsmethods.AddNew
                     rsmethods!cid = cid
                     rsmethods![mname] = minfo.Name
                     rsmethods![mreturntype] = minfo.ReturnType.TypeInfo.TypeKindString
                     rsmethods![mreturntypenumber] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                         Null, _
                                                         minfo.ReturnType.TypeInfoNumber)
                     rsmethods![mreturndatatype] = IIf(minfo.ReturnType.TypeInfoNumber = -1, _
                                                       minfo.ReturnType.VarType, _
                                                       Null)
                        methodid = rsmethods!methodid
                     rsmethods.Update
                        For Each pinfo In minfo.Parameters
                           rsparameters.AddNew
                           rsparameters!methodid = methodid
                           rsparameters![pName] = pinfo.Name
                           rsparameters![poptional] = pinfo.Optional
                           rsparameters![pflags] = pinfo.Flags
                           rsparameters![pdatatype] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                          Null, _
                                                          pinfo.VarTypeInfo.VarType)
                           rsparameters![pType] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                      pinfo.VarTypeInfo.TypeInfo.TypeKindString, _
                                                      Null)
                           rsparameters![ptypenumber] = IIf(pinfo.VarTypeInfo.VarType = 0, _
                                                            pinfo.VarTypeInfo.TypeInfoNumber, _
                                                            Null)
                           rsparameters.Update
                        Next pinfo
                  End If
               
               Next minfo
            Next iinfo
      End If
            
      Case Else
         'DO NOTHING
   
      End Select

Next tinfo

ExitProc:
   rsproperties.Close
   rsmethods.Close
   rsparameters.Close
   
   Set rs = Nothing
   Set rsproperties = Nothing
   Set rsmethods = Nothing
   Set rsparameters = Nothing
   Set x = Nothing

Exit Sub

End Sub