msoFileDialogFilePicker

michaelaa

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
    .AllowMultiSelect = False
    .Title = "选择文件"
    .Filters.Clear
    .Filters.Add "Excel文件", "*.xlsx", 1  如何改成只显示文件名是100001A.xlsx的文件
    .InitialFileName = "C:\"
    If .Show = -1 Then
        MsgBox "选择的文件: " & .SelectedItems(1)
    End If
End With

求教老师选择器里面显示的文件名最后一个字符是A的所有文件，应该怎么改，万分感谢。

quqiyuan

.Filters.Add "Excel文件", "*A.xlsx", 1
试一下

michaelaa

quqiyuan 发表于 2025-1-26 13:57
.Filters.Add "Excel文件", "*A.xlsx", 1
试一下

老师，感谢回复这样不行的，选择器，都显示不出来。

lizhipei78

都特定文件了，还筛选干嘛，直接用Dir指定文件好了

michaelaa

lizhipei78 发表于 2025-1-26 16:39
都特定文件了，还筛选干嘛，直接用Dir指定文件好了

有很多个文件，前面都是，一样的，最后一位按照A，B来区分，我不想显示所有的文件，是否可以按照A/B来加载呢？
10001A
10002A
10003A
.....

10001B
10002B
10003B
.....

quqiyuan

michaelaa 发表于 2025-1-26 13:59
老师，感谢回复这样不行的，选择器，都显示不出来。

哦，这个问题还真是只能对文件类型进行过滤，对文件名称是没有办法的吧。

opiona

自己画一个窗体  模拟文件选择器
显示文件列表时 先用DIR过滤一下

perfect131

michaelaa 发表于 2025-1-26 16:44
有很多个文件，前面都是，一样的，最后一位按照A，B来区分，我不想显示所有的文件，是否可以按照A/B来加 ...

这样              

perfect131

https://club.excelhome.net/thread-1664791-1-1.html

opiona

perfect131  牛啊!!

1. 
   
2. Sub TEST()
   
3.     PathY = GetFileName(KZM:="Excel文件,*.xls,*.xlsx;*.xlsm", Title:="请选择Excel文件", FileName:="", FileText:="*00*", BLAll:=False, StrSplitor:="")
   
4. 
   
5.     MsgBox PathY
   
6. End Sub
   
7. 
   
8. 
   
9. Rem *************************************************************************************************************
   
10. Rem 函数: GetFileName  选择单个文件：获得已经选择文件全路径,没选择的，返回：空白
    
11. Rem 参数：KZM          可选，默认是："Excel文件,*.xls;*.xlsx;*.xlsm"
    
12. Rem 参数：Title        可选，提示信息，默认是：北极狐工作室
    
13. Rem 参数：Filename     可选，开始文件夹，默认是：本表所在文件夹
    
14. Rem 参数：FileText     可选，过滤文件名 *过滤内容*
    
15. Rem 参数：BLAll        可选，是否显示所有文件, 默认:=true '//如果=false '//但是KMZ="",则自动添加: 所有文件
    
16. Rem 参数：StrSplitor   可选，各级文件夹分隔符
    
17. Rem 方法：PathY = GetFileName(KZM:="Excel文件,*.xls,*.xlsx;*.xlsm", Title:="请选择Excel文件", FileName:="",FileText:="", BLAll:=False, StrSplitor:="")
    
18. Rem 整理：北极狐工作室 QQ：14885553
    
19. Rem *************************************************************************************************************
    
20. Public Function GetFileName(Optional ByVal KZM = "Excel文件,*.xls;*.xlsx;*.xlsm", Optional ByVal Title As String = "", Optional ByVal FileName As String = "", Optional ByVal FileText As String = "", Optional ByVal BLAll As Boolean = True, Optional ByVal StrSplitor As String = "") As String
    
21.     Dim X As Long
    
22.     Dim ARX
    
23. 
    
24.     Rem 为了解决WPS 不出现对话框 需要加一对: Application.ScreenUpdating
    
25.     Dim BLAPP As Boolean
    
26.     BLAPP = Application.ScreenUpdating
    
27.     Application.ScreenUpdating = False
    
28. 
    
29.     Rem 默认的分隔符号
    
30.     If StrSplitor = "" Then StrSplitor = ""
    
31.     If FileName = "" Then FileName = ThisWorkbook.Path
    
32.     Rem 如果文件夹路径 最后不是：[\] 则补充上去
    
33.     If Right(FileName, 1) <> StrSplitor Then FileName = FileName & StrSplitor
    
34. 
    
35.     With Application.FileDialog(msoFileDialogFilePicker)
    
36.         .Filters.Clear   '清除文件过滤器，注意顺序
    
37.         If InStr(KZM, ",") > 0 Then
    
38.             Rem KZM="Excel2003,*.xls|Excel2007,*.xlsx;*.xlsm|WORD文件,*.doc;*.docx"
    
39.             Rem KZM="图片文件,*.png;*.bmp;*.jpeg;*.jpg"
    
40.             ARX = Split(KZM, "|")
    
41.             For X = 0 To UBound(ARX)
    
42.                 .Filters.Add Split(ARX(X), ",")(0), Split(ARX(X), ",")(1)
    
43.             Next
    
44. 
    
45.             Rem 注意顺序
    
46.             If BLAll = True Then .Filters.Add "所有文件", "*.*", 1   '增加筛选器的项目为所有文件
    
47.         Else
    
48.             Rem 注意顺序
    
49.             .Filters.Add "所有文件", "*.*", 1   '增加筛选器的项目为所有文件
    
50.         End If
    
51. 
    
52.         .AllowMultiSelect = False    '不允许多项选择
    
53.         .InitialFileName = FileName    '//设置默认文件夹
    
54.         .InitialFileName = FileText    '//设置过滤文件名
    
55.         If Title = "" Then   '//设置提示信息
    
56.             .Title = "北极狐工作室： 请选择文件存放的路径（文件夹）"    '自定义浏览对话框的标题栏名称，默认：“浏览”
    
57.         Else
    
58.             .Title = Title
    
59.         End If
    
60.         If .Show = -1 Then
    
61.             GetFileName = .SelectedItems(1)
    
62.         Else
    
63.             GetFileName = ""
    
64.         End If
    
65.     End With
    
66.     Application.ScreenUpdating = BLAPP
    
67. End Function
    

复制代码