ListExtension

Function ListFileExtensions() As String()
Dim regKeys As Collection
Dim regKey As Variant
Dim extsNdx As Long
Dim progID As String
Dim clsid As String

Const HKEY_CLASSES_ROOT = &H80000000

' retrieve all the subkeys under HKEY_CLASSES_ROOT

Set regKeys = EnumRegistryKeys(HKEY_CLASSES_ROOT, "")

' prepare the array of results

ReDim exts(3, regKeys.Count) As String

' ignore errors

On Error Resume Next

For Each regKey In regKeys
' check whether this is a File extension

If Left$(regKey, 1) = "." Then
' store the extension in the result array

extsNdx = extsNdx + 1
exts(0, extsNdx) = regKey
' the default value for this key is the ProgID

' or another string that can be searched in the Registry

progID = GetRegistryValue(HKEY_CLASSES_ROOT, regKey, "")
exts(1, extsNdx) = progID
' the default value of the key HKEY_CLASSES_ROOT\ProgID is

' the textual description of this entry

exts(2, extsNdx) = GetRegistryValue(HKEY_CLASSES_ROOT, progID, "")
If exts(2, extsNdx) = "" Then
' if this key doesn't exist, delete this entry

extsNdx = extsNdx - 1
Else
' else try to read the location of the associated EXE file

exts(3, extsNdx) = GetRegistryValue( _
HKEY_CLASSES_ROOT, progID & "\shell\open\command", "")
End If
End If
Next

' trim unused items

ReDim Preserve exts(3, extsNdx) As String
ListFileExtensions = exts()
End Function