VB6 Common Dialog Error in Windows 7

[Ellis Dee]

Try without the control. Delete the common dialog control and remove it from the components list. Then add a module named something like basCommonDlg.bas and copy this code to it:

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

Sample usage: (Note that the code requires any one form to be open, meaning this doesn't work from the debug window.)

Private Sub Command1_Click()
    MsgBox ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    MsgBox ShowSaveAsDialog(App.Path, "untitled.txt", "All Files|*.*", "*.*")
End Sub

[BWisinger]

I changed the code to report errors and use the API code but the error still exists. I am thinking it might have something to do with Windows 7 settings in general however and may not, in fact, be a problem with the code in particular. But I am uncertain.

[BillyP]

Ellis, Your replacement common dialog code helped me greatly. I am using VB6 on Win7x64. (Because I have to) In particular the common dialog control was giving me problems, but this works fine. Awesome.

[Nightwalker83]

Private Sub Command1_Click()
    MsgBox ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    MsgBox ShowSaveAsDialog(App.Path, "untitled.txt", "All Files|*.*", "*.*")
End Sub

How do I modify the code so I can refer to the file name?

[A_Nirwal]

Hi ,

I have applied this solution of using API code given in my application for OPEN Dialog box and it worked , However , when Open dialog box poped up , if User clicked on Cancel Button instead of Open button , it will display error , So could you please let me know how Cancel button/code can be handled on Form so its gracefully return back to Form , instead of error when pressed cancel button on OPEN dialog box.

Thanks
A_Nirwal

Try without the control. Delete the common dialog control and remove it from the components list. Then add a module named something like basCommonDlg.bas and copy this code to it:

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

Sample usage: (Note that the code requires any one form to be open, meaning this doesn't work from the debug window.)

Private Sub Command1_Click()
    MsgBox ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    MsgBox ShowSaveAsDialog(App.Path, "untitled.txt", "All Files|*.*", "*.*")
End Sub