Создание списка всех файлов каталога

Option Explicit
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const HKEY_CLASSES_ROOT = &H80000000
Dim fls$(), file$, idx&
 
 
Private Sub ListBox1_Click()
    Dim hWndDC&, DC&, icn&
    On Error GoTo IconErr
    file = Left$(fls(ListBox1.ListIndex), InStr(fls(ListBox1.ListIndex), ",") - 1)
    idx = Val(Mid$(fls(ListBox1.ListIndex), InStr(fls(ListBox1.ListIndex), ",") + 1))
    icn = ExtractIcon(Application.Hinstance, file, idx)
 
    hWndDC = ListBox1.[_GethWnd]
    DC = GetDC(hWndDC)
 
    Debug.Print file, idx, icn, ListBox1.[_GethWnd]
 
    Call DrawIconEx(DC, 0, 0, icn, 32, 32, 0, 0, 3)
IconErr:
    ReleaseDC hWndDC, DC
End Sub
 
Private Sub UserForm_Initialize()
    Dim tp$, nm$, rc&, fnd&
    idx = 1
    fnd = 1
    tp = Space(255)
    'Перечисление всех расширений
    Do While RegEnumKey(HKEY_CLASSES_ROOT, idx, ByVal tp, 255) = 0
        If Left(tp, 1) <> "." Then
        Else
            'Сохранение информации об иконке
            ReDim Preserve fls(idx - 1)
            tp = Left(tp, InStr(tp, Chr(0)) - 1)
            'Получить имя расширения, (к примеру - .zip = WinZip)
            If RegOpenKey(HKEY_CLASSES_ROOT, ByVal tp, rc) = 0 Then
                nm = Space(255)
                Call RegQueryValueEx(rc, ByVal "", 0&, 1, ByVal nm, 255)
                If InStr(nm, Chr(0)) Then nm = Left(nm, InStr(nm, Chr(0)) - 1)
                Call RegCloseKey(rc)
                If Len(Trim(nm)) Then
                    'Поиск иконки по умолчанию для расширения
                    If RegOpenKey(HKEY_CLASSES_ROOT, nm & "\DefaultIcon\", rc) = 0 Then
                        file = Space(255)
                        Call RegQueryValueEx(rc, ByVal "", 0&, 1, ByVal file, 255)
                        If InStr(file, Chr(0)) Then file = Left(file, InStr(file, Chr(0)) - 1)
                        Call RegCloseKey(rc)
                        fls(fnd - 1) = file
                    End If
                End If
            
            End If
            ListBox1.AddItem Left(tp & Space(10), 10) & " - " & nm
            fnd = fnd + 1
        End If
        tp = Space(255)
        idx = idx + 1
    Loop
End Sub