FileSystemObject + 输入框(简单选择)Set fso = CreateObject("Scripting.FileSystemObject")
' 弹出输入框让用户输入文件路径
filePath = InputBox("请输入文件完整路径:", "选择文件")
If filePath <> "" Then
If fso.FileExists(filePath) Then
MsgBox "文件路径: " & filePath, vbInformation, "文件信息"
Else
MsgBox "文件不存在!", vbCritical, "错误"
End If
Else
MsgBox "未选择文件", vbInformation, "提示"
End If
MSComDlg.CommonDialog(传统对话框)' 创建通用对话框对象
Set cd = CreateObject("MSComDlg.CommonDialog")
' 设置对话框属性
cd.Filter = "所有文件 (*.*)|*.*|文本文件 (*.txt)|*.txt|Word文档 (*.doc;*.docx)|*.doc;*.docx"
cd.FilterIndex = 1
cd.MaxFileSize = 260
cd.DialogTitle = "请选择文件"
cd.Flags = &H1000 + &H80000 + &H4 ' 文件必须存在 + 长文件名 + 路径必须存在
' 显示打开对话框
On Error Resume Next
cd.ShowOpen
If Err.Number = 0 Then
filePath = cd.FileName
If filePath <> "" Then
MsgBox "选择的文件: " & vbCrLf & filePath, vbInformation, "文件路径"
Else
MsgBox "未选择文件", vbInformation, "提示"
End If
Else
MsgBox "无法创建文件对话框", vbCritical, "错误"
End If
On Error GoTo 0
UserAccounts.CommonDialog(Vista及以上系统)' 创建文件选择对话框
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
' 使用 UserAccounts.CommonDialog(Windows Vista+)
On Error Resume Next
Set dia = CreateObject("UserAccounts.CommonDialog")
If Err.Number <> 0 Then
MsgBox "不支持 UserAccounts.CommonDialog,请使用方法2", vbCritical, "错误"
WScript.Quit
End If
On Error GoTo 0
' 设置对话框属性
dia.Filter = "所有文件|*.*"
dia.InitialDir = shell.ExpandEnvironmentStrings("%USERPROFILE%")
dia.FilterIndex = 0
If dia.ShowOpen Then
filePath = dia.FileName
MsgBox "选择的文件: " & vbCrLf & filePath, vbInformation, "文件路径"
Else
MsgBox "未选择文件", vbInformation, "提示"
End If
' 使用 Shell.Application 对象(最兼容的方式)
Set shellApp = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
' 获取桌面文件夹对象
Set objFolder = shellApp.BrowseForFolder(0, "请选择文件", 0)
If Not objFolder Is Nothing Then
' 如果是文件夹,获取其路径
folderPath = objFolder.Self.Path
' 如果要选择具体的文件,可以结合输入框
fileName = InputBox("请输入文件名(包含扩展名):", "选择文件", , , )
If fileName <> "" Then
fullPath = fso.BuildPath(folderPath, fileName)
If fso.FileExists(fullPath) Then
MsgBox "完整路径: " & vbCrLf & fullPath, vbInformation, "文件信息"
Else
MsgBox "文件不存在: " & vbCrLf & fullPath, vbExclamation, "提示"
End If
End If
End If
Function SelectFile(Optional defaultFilter As String = "所有文件|*.*")
On Error Resume Next
' 尝试使用 MSComDlg.CommonDialog
Set cd = CreateObject("MSComDlg.CommonDialog")
If Err.Number = 0 Then
cd.Filter = defaultFilter
cd.FilterIndex = 1
cd.MaxFileSize = 260
cd.DialogTitle = "选择文件"
cd.Flags = &H1000 + &H80000 + &H4
cd.ShowOpen
If Err.Number = 0 And cd.FileName <> "" Then
SelectFile = cd.FileName
Exit Function
End If
End If
Err.Clear
' 备用方法:使用输入框
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = InputBox("请输入文件完整路径:", "选择文件", "C:\")
If filePath <> "" And fso.FileExists(filePath) Then
SelectFile = filePath
Else
SelectFile = ""
End If
End Function
' 使用示例
filePath = SelectFile("文本文件|*.txt|所有文件|*.*")
If filePath <> "" Then
MsgBox "已选择文件:" & vbCrLf & filePath, vbInformation
Else
MsgBox "未选择文件", vbInformation
End If
兼容性说明:
MSComDlg.CommonDialog) 需要系统注册了该组件UserAccounts.CommonDialog) 仅适用于 Windows Vista 及以上系统Shell.Application) 兼容性最好,但只能选择文件夹运行权限:
推荐方案:
保存文件对话框:
如果需要保存文件,可以将 ShowOpen 改为 ShowSave
选择适合你系统环境和需求的方法使用即可。