WPS-FileDialog没有用好。

ning84 · 发表于 2024-9-27 11:06

Sub SelectFolderTraverseFileToRng()
Dim Str, ii, jj, Kk, Cc
Dim Fso As Scripting.FileSystemObject
Dim oFolder As Folder, oFile As Scripting.File
Set Fso = New Scripting.FileSystemObject
Dim FileDia As FileDialog
Set FileDia = Application.FileDialog(msoFileDialogFilePicker)
With FileDia
.AllowMultiSelect = True
.AllowMultiSelect = True
.Show
Str = .SelectedItems(1)
End With
Stop
End Sub

复制代码

沈默00 · 发表于 2024-9-27 11:13

附件发上来，，，

opiona · 发表于 2024-9-27 15:49

本帖最后由 opiona 于 2024-9-27 22:30 编辑

给你一个通用函数

见楼下

opiona · 发表于 2024-9-27 20:15

分享一个通用函数

Rem *************************************************************************************************************
Rem 选择单个文件： GetFileName
Rem 功能：获得已经选择文件全路径,没选择的，返回：空白
Rem 参数：KZM 可选，默认是："Excel文件,*.xls;*.xlsx;*.xlsm"
Rem 参数：Title 可选，提示信息，默认是：北极狐工作室
Rem 参数：Filename 可选，开始文件夹，默认是：本表所在文件夹
Rem 参数：StrSplitor 可选，各级文件夹分隔符
Rem 使用方法： PathY = GetFileName(KZM:="Excel文件,*.xls,*.xlsx;*.xlsm", Title:="请选择Excel文件", filename:="", StrSplitor:="")
Rem 作者：北极狐工作室 QQ：14885553
Rem *************************************************************************************************************
Public Function GetFileName(Optional ByVal KZM = "Excel文件,*.xls;*.xlsx;*.xlsm", Optional ByVal Title As String = "", Optional ByVal filename As String = "", Optional ByVal StrSplitor As String = "") As String
Dim X As Long
Dim ARX
Rem 为了解决WPS 不出现对话框需要加一对: Application.ScreenUpdating
Dim BLApp As Boolean
BLApp = Application.ScreenUpdating
Application.ScreenUpdating = False
Rem 默认的分隔符号
If StrSplitor = "" Then StrSplitor = ""
If filename = "" Then filename = ThisWorkbook.Path
Rem 如果文件夹路径最后不是：[\] 则补充上去
If Right(filename, 1) <> StrSplitor Then filename = filename & StrSplitor
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear '清除文件过滤器，注意顺序
If InStr(KZM, ",") > 0 Then
Rem KZM="Excel2003,*.xls|Excel2007,*.xlsx;*.xlsm|WORD文件,*.doc;*.docx"
Rem KZM="图片文件,*.png;*.bmp;*.jpeg;*.jpg"
ARX = Split(KZM, "|")
For X = 0 To UBound(ARX)
.Filters.Add Split(ARX(X), ",")(0), Split(ARX(X), ",")(1)
Next
End If
Rem 注意顺序
.Filters.Add "所有文件", "*.*", 1 '增加筛选器的项目为所有文件
.AllowMultiSelect = False '不允许多项选择
.InitialFileName = filename '//设置默认文件夹
If Title = "" Then '//设置提示信息
.Title = "北极狐工作室：请选择文件存放的路径（文件夹）" '自定义浏览对话框的标题栏名称，默认：“浏览”
Else
.Title = Title
End If
If .Show = -1 Then
GetFileName = .SelectedItems(1)
Else
GetFileName = ""
End If
End With
Application.ScreenUpdating = BLApp
End Function

复制代码

ning84 · 发表于 2024-9-28 09:32

opiona 发表于 2024-9-27 20:15
分享一个通用函数

谢谢回复。

Set FileDia = Application.FileDialog(msoFileDialogFilePicker) 结果成立。

Sub SelectFolderTraverseFileToRng()
Application.ScreenUpdating = True
Dim Str, ii, jj, Kk, Cc
Dim Fso As Scripting.FileSystemObject
Dim oFolder As Folder, oFile As Scripting.File
Set Fso = New Scripting.FileSystemObject
Dim FileDia As FileDialog
Set FileDia = Application.FileDialog(msoFileDialogFilePicker)
With FileDia
.AllowMultiSelect = True
.AllowMultiSelect = True
.Show
Str = .SelectedItems(1)
End With
Stop
End Sub

复制代码

Set FileDia = Application.FileDialog(msoFileDialogFolderPicker)结果不成立。
图书馆的WPS的VB好像与Office VBA有点却别。

ning84 · 发表于 2024-9-28 10:11

严重怀疑市图书馆2楼，电子阅览室的22好老年机安装的WPS有问题。

新建的表格，结果成立。D:\澳门巴士\澳门10路公交\StationPicture

Sub SelectFolderTraverseFileToRng()
Application.ScreenUpdating = True
Dim Str
Dim Fso As Scripting.FileSystemObject
Dim oFolder As Folder, oFile As Scripting.File
Set Fso = New Scripting.FileSystemObject
Dim FileDia As FileDialog
Set FileDia = Application.FileDialog(msoFileDialogFolderPicker)
With FileDia
.AllowMultiSelect = True
.Show
Str = .SelectedItems(1)
End With
Stop
Debug.Print Str
End Sub

复制代码

但是调用以前xlsm文件出错。

再次怀疑好像是WPS有问题。WPS同样代码，同一台机器，新建的表格结果成立，调用以前的WPS结果不成立。

opiona · 发表于 2024-9-28 15:52

Rem 为了解决WPS 不出现对话框需要加一对: Application.ScreenUpdating

		自动登录	找回密码
密码			免费注册

WPS-FileDialog没有用好。

评分