Советы тем, кто программирует на VB & VBA
Листинг 1. Обращение к диалоговому окну «Открыть/Сохранить» через WinAPI
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean
' Описатель данных для работы с окном "Открыть/Сохранить файл"
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
stFilter As String
stCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
stFileTitle As String
nMaxFileTitle As Long
stInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
stDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Константы для управления флагами окна "Открыть/Сохранить файл"
Public Enum OFN_FLAGS
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
Public Function FileOpenSave( _
Optional ByVal OpenFile As Boolean = True, _
Optional ByRef Flags As Long = 0&, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As String = vbNullString, _
Optional ByVal FilterIndex As Long = 1, _
Optional ByVal DefaultExt As String = vbNullString, _
Optional ByVal FileName As String = vbNullString, _
Optional ByVal DialogTitle As String = vbNullString, _
Optional ByVal hwnd As Long = -1) _
As String
'
' Процедура обращения к
' диалоговому окну "Открыть/Закрыть файл"
' OpenFile = True - ОТКРЫТЬ (по умолчанию)
' = False - ЗАКРЫТЬ
'
Dim ofn As OPENFILENAME ' структура для обращения
' к DLL-функции
Dim stFileName As String
Dim stFileTitle As String
Dim fResult As Boolean
' начальный каталог
If IsMissing(InitialDir) Then InitialDir = CurDir
If (hwnd = -1) Then hwnd = 0 ' установка описателя
' Подготовка строковых переменных
stFileName = Left$(FileName & String$(256, vbNullChar), 256)
stFileTitle = String$(256, vbNullChar)
' формирование данных для обращения к окну
With ofn
lStructSize = Len(ofn)
hwndOwner = hwnd
stFilter = Filter
nFilterIndex = FilterIndex
strFile = stFileName
nMaxFile = Len(stFileName)
stFileTitle = stFileTitle
nMaxFileTitle = Len(stFileTitle)
strTitle = DialogTitle
Flags = Flags
stDefExt = DefaultExt
stInitialDir = InitialDir
hInstance = 0
stCustomFilter = String$(255, vbNullChar)
nMaxCustFilter = 255
lpfnHook = 0
End With
If OpenFile Then ' открыть файл
fResult = GetOpenFileName(ofn)
Else 'сохранить файл
fResult = GetSaveFileName(ofn)
End If
If fResult Then ' Нажата кнопка "Open/Save"
Flags = ofn.Flags ' флаги
' имя файла
FileOpenSave = Left$(ofn.strFile, _
InStr(ofn.strFile, vbNullChar) - 1)
Else: FileOpenSave = "" ' нажата Cancel
End If
End Function
Public Sub Main()
' Тестирование конструкции FileOpenSave:
' обращение к окнам "Open/Save File" напрямую через DLL
'=============================
Dim bOpenFile As Boolean
' тип операции — TRUE (открыть)/FALSE (закрыть)
Dim Filter$, Flags&
Dim FileName$, InitDir$, Title$
InitDir$ = App.Path
Title$ = "Как выбрать имя каталога?"
tab]Filter$ = "Текстовые файлы (*.txt)" & _
Chr$(0) & "*.TXT" & Chr$(0) & _
"Все файлы (*.*)" & Chr$(0) & "*.*" & Chr$(0)
bOpenFile = True
FileName$ = FileOpenSave( _
bOpenFile, , InitDir, Filter, , ".txt", , Title$)
MsgBox FileName$
End Sub
