возможно иметь символы, предшествующие * в FilterDialog-фильтре?

Question

Я хочу создать FileDialog, фильтр которого разрешает только файлы, соответствующие выражению xyz*.xlsm; это позволит отображать файлы, такие как xyz123.xlsm и xyzzat.xlsm, но не xyz123.docx или abc123.xlsm.

Я использую этот код:

Sub testfd() 

Dim fd As FileDialog 

Set fd = Application.FileDialog(msoFileDialogFilePicker) 
fd.Filters.Add "xyz*", "xyz*.xlsm", 1 
If fd.Show = -1 Then 
    Debug.Print fd.SelectedItems(1) 
Else 
    Debug.Print "xyz" 
End If 


End Sub 

Однако fd.Filters.Add линии генерирует эти ошибки времени выполнения:

Invalid procedure call or argument 

Использование фильтра *.xlsm работает нормально.

Невозможно использовать .Filters.Add способом, который я изложил в своем коде выше? Если да, то как я могу убедиться, что пользователь только выбирает файлы, которые начинаются и заканчиваются заданной последовательностью символов?

Answer 1

If you badly need it, why not create it from scratch? It is slightly time consuming but simple. I remember doing it once... – Siddharth Rout 39 mins ago

Вот краткий пример, который я создал для вас (занял около 40 минут, чтобы создать его).

Создайте пользовательскую форму, как показано на изображении ниже, а затем назовите их, как показано на рисунке.

UserForm Код

Вставьте этот код в виде пользовательского

Option Explicit 

Dim justStarted As Boolean 

Private Sub UserForm_Initialize() 
    With ListBox1 
     .ColumnCount = 2 
     .ColumnWidths = "70;60" 
     .ListStyle = fmListStylePlain 
    End With 
    justStarted = True 
End Sub 

Private Sub UserForm_Activate() 
    justStarted = False 
    Populate 
End Sub 

'~~> Manually changing folder 
Private Sub InitialPath_Change() 
    If InitialPath = "" Or justStarted = True Then Exit Sub 

    If Dir(InitialPath) <> "" Then 
     Populate 
    Else 
     ListBox1.Clear 
     TextBox2.Text = "" 
    End If 
End Sub 

'~~> Listbox Single Click - File Selection 
Private Sub ListBox1_Click() 
    If ListBox1.ListIndex < 0 Then Exit Sub 

    If ListBox1.List(ListBox1.ListIndex, 1) = "File" Then _ 
    TextBox2.Text = ListBox1.List(ListBox1.ListIndex) 
End Sub 

'~~> Listbox Double Click - Folder Open 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
    If ListBox1.ListIndex < 0 Then Exit Sub 

    If ListBox1.List(ListBox1.ListIndex, 1) = "Folder" Then 
     If Right(Me.InitialPath, 1) <> "\" Then 
      InitialPath = Me.InitialPath & "\" & ListBox1.List(ListBox1.ListIndex, 0) & "\" 
     Else 
      InitialPath = Me.InitialPath & ListBox1.List(ListBox1.ListIndex, 0) & "\" 
     End If 

     Populate 
    End If 
End Sub 

'~~> Open Button 
Private Sub CommandButton1_Click() 
    If Len(Trim(TextBox2.Text)) = 0 Then Exit Sub 

    If Right(Me.InitialPath, 1) <> "\" Then InitialPath = Me.InitialPath & "\" 

    If Dir(InitialPath & TextBox2.Text) <> "" Then 
     MsgBox "You selected " & InitialPath & TextBox2.Text 
    Else 
     MsgBox "Please select a valid file" 
    End If 
End Sub 

'~~> Exit Button 
Private Sub CommandButton2_Click() 
    Unload Me 
End Sub 

'~~> Populate Listbox 
Sub Populate() 
    Dim sFile As Variant, sFolder As Variant 
    Dim sFilter As String 
    Dim pos As Long: pos = 0 

    ListBox1.Clear 

    Dim objFSO As Object, objFolder As Object, objSubFolder As Object 
    Dim i As Integer 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.GetFolder(InitialPath) 

    For Each objSubFolder In objFolder.subfolders 
     With ListBox1 
      .AddItem 
      .List(pos, 0) = objSubFolder.Name 
      .List(pos, 1) = "Folder" 
      pos = pos + 1 
     End With 
    Next objSubFolder 

    sFilter = Split(Filter, "(")(1) 
    sFilter = Split(sFilter, ")")(0) 
    Filter = sFilter 

    sFile = Dir(InitialPath & Trim(sFilter)) 

    While (sFile <> "") 
     With ListBox1 
      .AddItem 
      .List(pos, 0) = sFile 
      .List(pos, 1) = "File" 
      pos = pos + 1 
     End With 
     sFile = Dir 
    Wend 
End Sub 

Модуль

Из модуля можно назвать, как

Sub Sample() 
    With MyFileBrowser 
     .InitialPath = "C:\Users\Siddharth\Desktop\" 
     .Filter = "My Files,(*ture*.*)" 
     .Caption = "Open" 
     .Show 
    End With 
End Sub 

в действии

Отказ от ответственности:

1. Обработка ошибок не сделано.
2. работает только с Одиночные фильтры
3. Filter текстовое поле заблокировано для редактирования

Пример файла

https://www.dropbox.com/s/w6ckyp9xvgdshho/File%20Browser%20Example.xlsm?dl=0

Answer 2

Вероятно, вам не нужно будет решение больше, но это может быть полезным для других пользователей, которые, как и я, искали решение этой проблемы.

Существует способ фильтрации файлов за пределами фильтров типа файла. В следующем примере я хочу видеть только файлы html в папке, которые начинаются со строки, содержащейся в «AccountNr». Для этого я добавляю строку AccountNr плюс звездочку к InitialFileName. Путь папки не изменяется этим добавлением в InitialFileName. Поле выбора в окне FileDialog отобразит строку AccountNr со звездочкой. (Основной код был найден в StackOverflow, я изменил его для своих нужд)

Private Function GetURL(AccountNr) 
    Dim fd As Office.FileDialog 

    Set fd = Application.FileDialog(msoFileDialogFilePicker) 

    With fd 

     .InitialFileName = "C:\Users\xxxed\Downloads\YY\" & AccountNr & "*" 
       'set directory (initial file path) & AccountNr 

     .AllowMultiSelect = False 

     ' Set the title of the dialog box. 
     .Title = "Please select the file." 

     ' Clear out the current filters, and add our own. 
     .Filters.Clear 
     .Filters.Add "HTML Files", "*.html" 'This filters files with "AccountNr*.html" 
     .Filters.Add "All Files", "*.*"  'alternative filter: all types 

     ' Show the dialog box. If the .Show method returns True, the 
     ' user picked at least one file. If the .Show method returns 
     ' False, the user clicked Cancel. 
     If .Show = True Then 
      GetURL = .SelectedItems(1)  'This is the file name and path 
     Else 
      GetURL = "" 
     End If 
    End With 
End Function