' класс вызова диалога открытия и сохранения файла "clsOpenDialog"
Private Type OpenFileName lpStructSize 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 Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private mstrStartDir As String Private mstrFilter As String Private mstrTitle As String Private mstrFileExt As String Private mstrPath As String Private mstrFileName As String Private mstrFullName As String
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 Sub Initialize() mstrStartDir = "c:" mstrFilter = "Все файла;*.*" mstrTitle = "Открытие файла" mstrFileExt = "" mstrPath = "" mstrFileName = ""
End Sub Public Function OpenDialogFileName(Optional lngHwin As Long = 0) As String Dim ofs As OpenFileName Dim Res As Long Dim S As String Dim SS As String Dim i As Byte ofs.lpstrInitialDir = mstrStartDir ' Здесь твой каталог по умолчанию ofs.lpStructSize = 76 ofs.nMaxFile = 1024 ofs.nMaxFileTitle = 256 ofs.lpstrFile = String(1024, vbNullChar) ofs.lpstrFileTitle = String(1024, vbNullChar) ofs.hwndOwner = lngHwin ofs.lpstrTitle = mstrTitle ofs.lpstrFilter = CreateFilterString(mstrFilter) Res = GetOpenFileName(ofs) S = "" For i = 1 To 255 SS = Mid(ofs.lpstrFile, i, 1) If SS <> Chr(0) Then S = S & SS Else Exit For Next i OpenDialogFileName = S mstrFullName = S mstrFileExt = Mid(S, ofs.nFileExtension + 1, Len(S) - ofs.nFileExtension) mstrPath = Left(S, ofs.nFileOffset) mstrFileName = Mid(S, ofs.nFileOffset + 1, Len(S) - ofs.nFileOffset) End Function
Public Function SaveDialogFileName(Optional lngHwin As Long = 0) As String
Dim ofs As OpenFileName
Dim Res As Long
Dim S As String
Dim SS As String
Dim i As Byte
ofs.lpstrInitialDir = mstrStartDir ' Здесь твой каталог по умолчанию
ofs.lpStructSize = 76
ofs.nMaxFile = 1024
ofs.nMaxFileTitle = 256
ofs.lpstrFile = String(1024, vbNullChar)
ofs.lpstrFileTitle = String(1024, vbNullChar)
ofs.hwndOwner = lngHwin
ofs.lpstrTitle = mstrTitle
ofs.lpstrFilter = CreateFilterString(mstrFilter)
Res = GetSaveFileName(ofs)
S = ""
For i = 1 To 255
SS = Mid(ofs.lpstrFile, i, 1)
If SS <> Chr(0) Then S = S & SS Else Exit For
Next i
SaveDialogFileName = S
mstrFullName = S
mstrFileExt = Mid(S, ofs.nFileExtension + 1, Len(S) - ofs.nFileExtension)
mstrPath = Left(S, ofs.nFileOffset)
mstrFileName = Mid(S, ofs.nFileOffset + 1, Len(S) - ofs.nFileOffset)
End Function
Public Property Get StartFolder() As String
StartFolder = mstrStartDir
End Property
Public Property Let StartFolder(ByVal vNewValue As String) ' стартовый каталог mstrStartDir = vNewValue End Property Public Property Get strFilter() As String strFilter = mstrFilter End Property Public Property Let strFilter(ByVal strNewFilter As String) ' строка фильтра для выбора mstrFilter = strNewFilter End Property Public Property Get strTitle() As String strTitle = mstrTitle End Property Public Property Let strTitle(ByVal strNewTitle As String) ' заголовок окна mstrTitle = strNewTitle End Property Private Function CreateFilterString(strFilter As String) As String ' Создает из строки строку фильтра. ' Если передано нечетное число аргументов, добавляется *.*
Dim strCreateFilter As String Dim i As Integer Dim strTemp As String i = 0 strTemp = Trim(SubStr(strFilter, ";", i)) & "" Do While Len(strTemp) > 0 strCreateFilter = strCreateFilter & strTemp & Chr$(0) i = i + 1 strTemp = Trim(SubStr(strFilter, ";", i)) & "" Loop If i Mod 2 = 0 Then strCreateFilter = strCreateFilter & Chr$(0)
Else strCreateFilter = strCreateFilter & "*.*" & Chr$(0) & Chr$(0) End If CreateFilterString = strCreateFilter End Function Private Function SubStr(ByVal strVal As String, ByVal strSep As String, ByVal nItem As Integer) As Variant
' strVal - строка (Например: "DRIVER={SQL Server};SERVER=SEQUEL1;DATABASE=pubs;UID=sa;PWD=") ' strSep - разделитель (";") ' nItem - номер подстроки от 0 до ... , (если 0 возвратит "DRIVER={SQL Server}") ' Dim startPos As Integer, _ savePos As Integer, _ nSepLen As Integer, _ nCount As Integer
savePos = 1 nSepLen = Len(strSep) nCount = 0 Do While True startPos = InStr(savePos, strVal, strSep) If startPos > 0 Then If nCount = nItem Then SubStr = Mid(strVal, savePos, startPos - savePos) Exit Do Else savePos = startPos + nSepLen nCount = nCount + 1 End If Else If nCount = nItem Then SubStr = Mid(strVal, savePos) Else SubStr = Null End If Exit Do End If Loop End Function
Public Property Get strFileExt() As String ' Расширение выбраного файла strFileExt = mstrFileExt End Property
Public Property Get strPath() As String ' путь к выбранному файлу strPath = mstrPath End Property Public Property Get strFileName() As String ' имя выбранного файла strFileName = mstrFileName End Property Public Property Get strFullName() As String ' Полный путь с именем выбранного файла strFullName = mstrFullName End Property
'пример вызова диалога открытия Private Sub cmdOpenDialog_Click() Dim odialog As New clsOpenDialog Dim strSelFile As String With odialog .StartFolder = "c:/windows" ' стартовая папка. Можно не задавать. По умолчанию c:/ .strTitle = "Укажите файл для проверки" ' заголовок окна. Можно не задавать. По умолчанию "Открытие файла" .strFilter = "Базы Access (*.MDB);*.mdb;Все файлы (*.*);*.*" 'строка для фильтра. Можно не задавать. По умолчанию "ВСЕ файлы"
If .OpenDialogFileName(Me.hWnd) = "" Then ' нажата кнопка "отмена" MsgBox "ничего не выбрано" Else ' выбран файл выводим его атрибуты MsgBox "Полное имя - " & .strFullName & vbCrLf & _ "Путь к файлу - " & .strPath & vbCrLf & _ "Имя файла - " & .strFileName & vbCrLf & _ "Расширение - " & .strFileExt End If End With End Sub
'пример вызова диалога сохранения
Private Sub cmdSaveDialog_Click()
Dim odialog As New clsOpenDialog
Dim strSelFile As String
With odialog
.StartFolder = "c:/windows" ' стартовая папка. Можно не задавать. По умолчанию c:/
.strTitle = "Укажите имя файла для сохранения" ' заголовок окна.
.strFilter = "Базы Access (*.MDB);*.mdb;Все файлы (*.*);*.*" 'строка для фильтра. Можно не задавать. По умолчанию "ВСЕ файлы"
If .SaveDialogFileName(Me.hWnd) = "" Then ' нажата кнопка "отмена"
MsgBox "ничего не выбрано"
Else ' выбран файл выводим его атрибуты
MsgBox "Полное имя - " & .strFullName & vbCrLf & _
"Путь к файлу - " & .strPath & vbCrLf & _
"Имя файла - " & .strFileName & vbCrLf & _
"Расширение - " & .strFileExt
End If
End With
End Sub