可能在FileDialog过滤器中有*之前的字符?

时间:2015-08-04 18:23:09

标签: excel vba excel-vba

我想创建一个FileDialog,其过滤器只允许与表达式xyz*.xlsm匹配的文件;这样就可以选择xyz123.xlsmxyzzat.xlsm等文件,但不能选择xyz123.docxabc123.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?如果是这样,我怎样才能确保用户只选择以给定字符序列开头和结尾的文件?

2 个答案:

答案 0 :(得分:1)

  

如果您非常需要它,为什么不从头开始创建它?这有点耗时但很简单。我记得曾经做过一次...... - Siddharth Rout 39分钟前

以下是我为您创建的一个简单示例(创建它需要大约40分钟)。

创建一个userform,如下图所示,然后如图所示命名。

enter image description here

用户形式代码

将此代码粘贴到用户表单

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

在行动

enter image description here

enter image description here

<强>声明

  1. 错误处理未完成。
  2. 仅适用于单个过滤器
  3. Filter文本框已被锁定以进行编辑
  4. 示例文件

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

答案 1 :(得分:0)

可能您不再需要解决方案,但这对于像我一样寻找此问题解决方案的其他用户可能会有所帮助。

有一种方法可以过滤文件类型过滤器之外的文件。在下面的示例中,我想只查看文件夹中的html文件,该文件以&#34; AccountNr &#34;中包含的字符串开头。 为此,我将 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