Настройка окна выбора файлов на большое количество файлов

Option Explicit
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXPLORER = &H80000
'Don 't change Windows's current directory to match the one chosen in the dialog box.
Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
Public Function ShowOpen(strFilter As String, strTitle As String) As Variant
  Dim strTemp As String
  Dim VertName As OPENFILENAME
  VertName.lStructSize = Len(VertName)
  VertName.hwndOwner = ThisDrawing.hWnd
  VertName.lpstrFilter = strFilter
  VertName.lpstrFile = Space$(254)
  VertName.nMaxFile = 255
  VertName.lpstrFileTitle = Space$(254)
  VertName.nMaxFileTitle = 255
  VertName.lpstrInitialDir = CurDir
  VertName.lpstrTitle = strTitle
  VertName.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER
  If GetOpenFileName(VertName) Then
    strTemp = (Trim(VertName.lpstrFile))
    Set ShowOpen = ПолучитьСемействоПодстрок(Left(strTemp, Len(strTemp) - 1), Right(strTemp, 1))
  End If
End Function
Private Function ПодсчётКоличестваЛексем(ByVal strТекст As String, ByVal strРаделитель As String) As Long
'Фунция определения числа появлений строки strРаделитель в строке strТекст (стр. 61 "Программирование в Microsoft Office. Полное руководство по VBA")
Dim lngКоличество As Long
Dim lngНачПозиция As Long
'Если не задана строка для поиска, то, естественно,
'ничего не может быть найдено, таким образом возвращается 0
   If VBA.Len(strТекст) > 0 Then
      lngНачПозиция = 1
      Do
         lngНачПозиция = VBA.InStr(lngНачПозиция, strТекст, strРаделитель, vbTextCompare)
         If lngНачПозиция > 0 Then
            lngКоличество = lngКоличество + 1
            lngНачПозиция = lngНачПозиция + VBA.Len(strРаделитель)
         End If
      Loop While lngНачПозиция > 0
   Else
      lngКоличество = 0
   End If
   ПодсчётКоличестваЛексем = lngКоличество
End Function
Private Function ВыделениеЗаданнойПодстроки(ByVal strТекст As String, ByVal lngНомСлова As Long, _
   ByVal strРазделители As String) As String
'Функция выделения лексем из списка с разделителями (стр. 85 "Программирование в Microsoft Office. Полное руководство по VBA")
'Список содержится в переменной strТекст
'а параметр lngНомСлова определяет, какой из фрагментов выделять
Dim lngНомПозиции As Long
Dim lngПрошлаяПозиция As Long
Dim lngНомНайденногоСлова As Long
Dim lngНайденнаяПозиция As Long
   lngНомПозиции = 1
   lngПрошлаяПозиция = -Len(strРазделители) + 1
   lngНомНайденногоСлова = lngНомСлова
   Do While lngНомНайденногоСлова > 0
      lngПрошлаяПозиция = lngНомПозиции
      lngНайденнаяПозиция = VBA.InStr(lngНомПозиции, strТекст, strРазделители)
      If lngНайденнаяПозиция > 0 Then
         lngНомПозиции = lngНайденнаяПозиция + Len(strРазделители)
         lngНомНайденногоСлова = lngНомНайденногоСлова - 1
      Else
         Exit Do
      End If
   Loop
'Если искомой строки не обнаружено,
'Данная итерация не была первой
'(в этом случае значения lngНомНайденногоСлова и lngНомСлова были бы равны)
'и lngНомНайденногоСлова > 1, то вы закончили просмотр лексем, не найдя нужную
'Это означает, что номер лексемы был слишком большим
'В таком случае возвращается ""
   If (lngНайденнаяПозиция = 0) And (lngНомНайденногоСлова <> lngНомСлова) And (lngНомНайденногоСлова > 1) Then
      ВыделениеЗаданнойПодстроки = ""
   Else
      ВыделениеЗаданнойПодстроки = VBA.Mid$(strТекст, lngПрошлаяПозиция, lngНайденнаяПозиция - lngПрошлаяПозиция)
   End If
End Function
Private Function ПолучитьСемействоПодстрок(ByVal strТекст As String, ByVal strРаделитель As String) As Variant
'Возвращает семейство, содержащее все лексемы строки,
'используя указанные разделители (стр. 91 "Программирование в Microsoft Office. Полное руководство по VBA")
Dim colКоллекцияЛексем As New Collection
Dim lngНомЛексемы  As Long
Dim strВременнаяСтрока  As String
Dim lngКолвоЛексем As Long
Dim strСимвол As String * 1
'Определяется количество лексем в заданной строке
   lngКолвоЛексем = ПодсчётКоличестваЛексем(strТекст, strРаделитель)
'Цикл по всем лексемам с добавлением их к выходному семейству
   For lngНомЛексемы = 1 To lngКолвоЛексем
      strВременнаяСтрока = ВыделениеЗаданнойПодстроки(strТекст, lngНомЛексемы, strРаделитель)
      colКоллекцияЛексем.Add strВременнаяСтрока, strВременнаяСтрока
   Next lngНомЛексемы
   'Возврат выходного семейства
   Set ПолучитьСемействоПодстрок = colКоллекцияЛексем
End Function