CommonDialogs.bas #3

Attribute VB_Name = "CommonDialogs"
Option Explicit
 
Private Enum FlagsEnum
    feOpen
    feSaveAs
End Enum
 
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 Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

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
 
' Common Dialog - Open
Public Function ShowOpenDialog(pstrInitialPath As String, pstrFilter As String, pstrDefaultExt As String) As String
    Dim typFileName As OPENFILENAME
            
    typFileName = GetStructure(pstrInitialPath, "", pstrFilter, pstrDefaultExt, feOpen)
    If GetOpenFileName(typFileName) Then ShowOpenDialog = Left$(typFileName.lpstrFile, InStr(typFileName.lpstrFile, Chr$(0)) - 1)
End Function
 
' Common Dialog - SaveAs
Public Function ShowSaveAsDialog(pstrInitialPath As String, pstrFile As String, pstrFilter As String, pstrDefaultExt As String) As String
    Dim typFileName As OPENFILENAME
    
    typFileName = GetStructure(pstrInitialPath, pstrFile, pstrFilter, pstrDefaultExt, feSaveAs)
    If GetSaveFileName(typFileName) Then ShowSaveAsDialog = Left$(typFileName.lpstrFile, InStr(typFileName.lpstrFile, Chr$(0)) - 1)
End Function
 
Private Function GetStructure(pstrPath As String, pstrFile As String, pstrFilter As String, pstrDefaultExt As String, penFlags As FlagsEnum) As OPENFILENAME
    Const OFN_FILEMUSTEXIST = &H1000
    Const OFN_PATHMUSTEXIST = &H800
    Const OFN_HIDEREADONLY = &H4
    Const OFN_LONGNAMES = &H200000
    Const OFN_OVERWRITEPROMPT = &H2
    Const OF_WRITE = &H1
    Const MAX_PATH = 260
    Dim frm As Form
 
    With GetStructure
        .lStructSize = Len(GetStructure)
        ' Get any form's window handle
        For Each frm In Forms
            Exit For
        Next
        .hwndOwner = frm.hwnd
        Set frm = Nothing
        .hInstance = App.hInstance
        .lpstrFilter = Replace(pstrFilter, "|", Chr(0)) & Chr(0)
        .nMaxFile = MAX_PATH + 1
        .nMaxFileTitle = MAX_PATH + 1
        .lpstrFileTitle = Space(MAX_PATH)
        .lpstrInitialDir = pstrPath
        .lpstrDefExt = pstrDefaultExt
        Select Case penFlags
            Case feOpen
                .lpstrTitle = "Open"
                .lpstrFile = Space(MAX_PATH)
                .Flags = OFN_FILEMUSTEXIST + OFN_HIDEREADONLY + OFN_LONGNAMES
            Case feSaveAs
                .lpstrTitle = "Save As"
                .lpstrFile = pstrFile & Space$(MAX_PATH - Len(pstrFile))
                .Flags = OFN_PATHMUSTEXIST + OFN_HIDEREADONLY + OFN_LONGNAMES + OF_WRITE ' + OFN_OVERWRITEPROMPT
        End Select
    End With
End Function