用API函数GetOpenFileName和GetSaveFileName来创建“打开”和“另存为”对话框。
OPENFILENAMEA (commdlg.h) - Win32 apps | Microsoft Learn
https://learn.microsoft.com/zh-cn/windows/win32/api/commdlg/ns-commdlg-openfilenamea
新建一个标准EXE工程,加入一个窗口和标准模块。
窗口代码如下:
'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址:https://blog.csdn.net/zezese
'电子邮箱:31319180@qq.com
Option Explicit
Private Sub Command1_Click()
Debug.Print OpenFile(Me.hwnd, "文本文件(*.txt)|*.txt")
End Sub
Private Sub Command2_Click()
Debug.Print SaveFile(Me.hwnd, "文本文件", ".txt")
End Sub
标准模块代码如下:
'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址:https://blog.csdn.net/zezese
'电子邮箱:31319180@qq.com
Option Explicit
Public Enum DialogFlags
OFN_READONLY = &H1
OFN_OVERWRITEPROMPT = &H2
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_NOVALIDATE = &H100
OFN_ALLOWMULTISELECT = &H200
OFN_EXTENSIONDIFFERENT = &H400
OFN_PATHMUSTEXIST = &H800
OFN_FILEMUSTEXIST = &H1000
OFN_CREATEPROMPT = &H2000
OFN_SHAREAWARE = &H4000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NONETWORKBUTTON = &H20000
OFN_NOLONGNAMES = &H40000
OFN_EXPLORER = &H80000
OFN_NODEREFERENCELINKS = &H100000
OFN_LONGNAMES = &H200000
End Enum
Private Const MAX_PATH As Long = 260
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As DialogFlags
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private OpenPath As String
Private SavePath As String
Function SaveFile(ByVal hwnd As Long, ByVal dlgFilterDescription As String, ByVal dlgFilter As String, _
Optional ByVal dlgTitle As String = "另存为", Optional ByVal dlgIniDir) As String
On Error Resume Next
Dim OFName As OPENFILENAME, sFileName As String
With OFName
'设置结构的大小
.lStructSize = Len(OFName)
'设置父窗口
.hwndOwner = hwnd
'设置程序的实例
.hInstance = App.hInstance
'设置过滤属性
.lpstrFilter = dlgFilterDescription & "(*" & dlgFilter & ")" & Chr(0) & "*" & dlgFilter & Chr(0)
'设置默认扩展名
.lpstrFile = String(MAX_PATH, Chr(0))
'设置返回的文件(全路径)的最大长度
.nMaxFile = MAX_PATH
'为文件名称创建缓冲区
.lpstrFileTitle = String(MAX_PATH, Chr(0))
'设置返回的文件名称的最大长度
.nMaxFileTitle = MAX_PATH
If IsMissing(dlgIniDir) Then
.lpstrInitialDir = SavePath
Else
.lpstrInitialDir = dlgIniDir
End If
'设置对话框标题
.lpstrTitle = dlgTitle
.flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
End With
If GetSaveFileName(OFName) Then
sFileName = GetUsefullStr(OFName.lpstrFile)
If Right(sFileName, 4) <> Trim(dlgFilter) Then
SaveFile = sFileName & Trim(dlgFilter)
Else
SaveFile = sFileName
End If
SavePath = GetPath(sFileName)
Else
SaveFile = ""
End If
End Function
Function OpenFile(ByVal hwnd As Long, ByVal dlgFilter As String, _
Optional ByVal dlgTitle As String = "打开", Optional ByVal dlgIniDir) As String
On Error Resume Next
Dim OFName As OPENFILENAME, sFileName As String
With OFName
'设置结构的大小
.lStructSize = Len(OFName)
'设置父窗口
.hwndOwner = hwnd
'设置程序的实例
.hInstance = App.hInstance
'设置过滤属性
.lpstrFilter = ChangeStr(dlgFilter)
'设置默认扩展名
.lpstrFile = String(MAX_PATH, Chr(0))
'设置返回的文件(全路径)的最大长度
.nMaxFile = MAX_PATH
'为文件名称创建缓冲区
.lpstrFileTitle = String(MAX_PATH, Chr(0))
'设置返回的文件名称的最大长度
.nMaxFileTitle = MAX_PATH
If IsMissing(dlgIniDir) Then
.lpstrInitialDir = OpenPath
Else
.lpstrInitialDir = dlgIniDir
End If
'设置对话框标题
.lpstrTitle = dlgTitle
.flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
End With
If GetOpenFileName(OFName) Then
sFileName = GetUsefullStr(OFName.lpstrFile)
OpenFile = sFileName
OpenPath = GetPath(sFileName)
Else
OpenFile = ""
End If
End Function
Function OpenFiles(ByVal hwnd As Long, FileNames() As String, ByVal dlgFilter As String, _
Optional ByVal dlgTitle As String = "打开", Optional ByVal dlgIniDir) As Long
On Error Resume Next
Dim OFName As OPENFILENAME
With OFName
'设置结构的大小
.lStructSize = Len(OFName)
'设置父窗口
.hwndOwner = hwnd
'设置程序的实例
.hInstance = App.hInstance
'设置过滤属性
.lpstrFilter = ChangeStr(dlgFilter)
'设置默认扩展名
.lpstrFile = String(2048, Chr(0))
'设置返回的文件(全路径)的最大长度
.nMaxFile = 2048
'为文件名称创建缓冲区
.lpstrFileTitle = String(2048, Chr(0))
'设置返回的文件名称的最大长度
.nMaxFileTitle = 2048
If IsMissing(dlgIniDir) Then
.lpstrInitialDir = OpenPath
Else
.lpstrInitialDir = dlgIniDir
End If
'设置对话框标题
.lpstrTitle = dlgTitle
.flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
End With
If GetOpenFileName(OFName) Then
OpenFiles = GetFiles(OFName.lpstrFile, FileNames)
OpenPath = GetPath(FileNames(0))
Else
Dim fn(0) As String
FileNames = fn()
OpenFiles = 0
End If
End Function
Private Function ChangeStr(ByVal s As String) As String
s = Trim(s)
If s = "" Then Exit Function
ChangeStr = Replace(s, "|", Chr(0))
End Function
Private Function GetUsefullStr(ByVal s As String) As String
s = Trim(s)
If s = "" Then Exit Function
GetUsefullStr = Left(s, InStr(1, s, Chr(0)) - 1)
End Function
Private Function GetPath(ByVal s As String) As String
Dim i As Long
For i = Len(s) To 1 Step -1
If Mid(s, i, 1) = "\" Then
GetPath = Left(s, i)
Exit For
End If
Next
End Function
Private Function GetFiles(ByVal s As String, fns() As String) As Long
Dim n As Long, i As Long
Dim MultiFile As Boolean
Dim fn() As String, FileNames() As String
For i = Len(s) To 1 Step -1
If Asc(Mid(s, i, 1)) <> 0 Then
s = Left(s, i)
Exit For
End If
Next
For i = 1 To Len(s)
If Asc(Mid(s, i, 1)) = 0 Then
MultiFile = True
Exit For
End If
Next
If MultiFile Then
fn = Split(s, Chr(0))
ReDim FileNames(UBound(fn) - 1)
For i = 1 To UBound(fn)
FileNames(i - 1) = fn(0) & "\" & fn(i)
Next
GetFiles = UBound(fn)
Else
ReDim FileNames(0)
FileNames(0) = s
GetFiles = 1
End If
fns = FileNames
End Function