VB6 Common Dialog Error in Windows 7

[BWisinger]

When using the CommonDialog control, to open files the program EXE is being locked and the file cannot be moved, deleted, or changed once the program has been closed. Trying to relaunch the program also results in an error. The only way to relaunch the program is the restart the machine. This only happens in Windows 7 but I cannot find anyone else that has experienced a similar problem.

The code is fairly old, still using the Action Property of the CommonDialog but even switching to use the newer ShowOpen method does not fix this. It does not mater if I actually open a file or not. Even selecting Cancel on the screen will still cause the EXE to be locked.

[akhileshbc]

Welcome to the forums.....

Have you tried Run as Administrator option ...???

[BWisinger]

I have but the same error occurs. It's rather strange. There has been no problem in XP or Vista with this program. The code used for the CommonDialog follows every example I've ever seen for it:
dlgFile.Flags = OFN_HIDEREADONLY
dlgFile.Filter = "Inventory Files (*.inv)|*.inv|Access Database (*.mdb)|*.mdb|All Files (*.*)|*.*"
dlgFile.DefaultExt = "inv"
dlgFile.FileName = ""
dlgFile.Initdir = gvsInventory$
dlgFile.Dialogtitle = "Open an Inventory File"
dlgFile.Action = DLG_FILE_OPEN
If dlgFile.FileName = "" Then gvnTerminate = True: Exit Sub
ChDrive Left$(gvsProgram$, 2)
ChDir Mid$(gvsProgram$, 3)
If Err <> 0 Then gvnTerminate = True: Exit Sub
On Error GoTo 0
Screen.MousePointer = vbHourglass
OpenInventory dlgFile.FileName
gvnTerminate% = True
Screen.MousePointer = vbDefault
Me.SetFocus

It definately happens within the CommonDialog, I know, because I have opened the files in other ways without using the CommonDialog, such as hardcoding file names and I have also launched the CommonDialog without opening a file and still have the error.

[akhileshbc]

Could you try commenting out these two lines:

'ChDrive Left$(gvsProgram$, 2)
'ChDir Mid$(gvsProgram$, 3)

[BWisinger]

One of many options I've already tried. I also tried updating code to use the "ShowOpen" property as opposed to the "Action" property. Setting the initial directory to another directory after returning from the CommonDialog. Using ChDir to point to another directory after returning from the CommonDialog. And using the API commonDialog as opposed to the VB6 component.

[si_the_geek]

It looks like you are using On Error Resume Next in a way that is not apt, even if you weren't having this kind of issue.

As you are having an issue, having it in there is the worst thing you can do - because it is explicitly hiding any errors from you, and there is a very strong chance that you are getting errors.


In addition to that, you should check what gvsInventory$ contains, and whether or not it points to a valid folder.

[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.

[si_the_geek]

I'm on Windows 7, and I've just tested your code (up as far as the If dlgFile.FileName line) with an apt .InitDir for my machine, and values for OFN_HIDEREADONLY and DLG_FILE_OPEN (which I hope you have valid constants for).

There was no kind of issue at all, and it all worked as it should have.

[BWisinger]

Still getting the error. I'm not debugging on the Windows 7 machine, VisualStudio is not installed there, so I can't determine the error in that way. I am debugging and designing on an XP machine. The Windows 7 machine is only getting the finalized EXE to test.

Researching a little bit more of my problem I have determined this: When first opened the program runs fine. Whenever the common dialog is launched for Open or Save As something happens. Then when I go to close the program it seems to close normally but the process remains in the system, this does not happen with the same EXE on XP. Then whenever I go to relaunch the program a check is performed to see if the program is already running to avoid opening to separate instances of the program. When doing this the existing process is seen and is made active. That's where the error occurs.

[TheBigB]

Back to the common dialog control;
Have you copied comdlg32.ocx to the program folder or system32 folder?

[BWisinger]

It's in the system32 folder.

[LaVolpe]

...Researching a little bit more of my problem I have determined this: When first opened the program runs fine. Whenever the common dialog is launched for Open or Save As something happens. Then when I go to close the program it seems to close normally but the process remains in the system, this does not happen with the same EXE on XP. Then whenever I go to relaunch the program a check is performed to see if the program is already running to avoid opening to separate instances of the program. When doing this the existing process is seen and is made active. That's where the error occurs.

This, I would say, is a strong indication as the reason of your initial problem reported in post #1. If it is still running, obviously you can't rename, delete or move it.

What does your form's Unload and/or QueryUnload code look like?
Can you display the entire routine that has the code in post #3?

[BWisinger]

That actually is the full routine, minus the sub XXXX ... end sub.

As for the Unload and QueryUnload, the Unload is empty and QueryUnload has:

If Not ExitRoutine%() Then Cancel = True
'
Dim FormX As Form
For Each FormX In Forms
  If FormX.hwnd <> Me.hwnd Then
    MsgBox FormX.Name & " is still loaded"
    Unload FormX
  End If
Next

If (tmrClock.Enabled = True) Then
    MsgBox "tmrClock.enabled is TRUE"
End If
If (tmrSketchBlock.Enabled = True) Then
    MsgBox "tmrSketchBlock.enabled is TRUE"
End If

Some of this recently added for testing and trying new ways to correct the error.

ExitRoutine is a function that will close the database files used by the program:

If Not gvnTerminate% Then
    MsgBox DynamicText("BAS-MN10-006")
    ExitRoutine% = False
    Exit Function
End If
'
If MsgBox(DynamicText("BAS-MN10-007"), vbYesNo + vbQuestion) = vbNo Then
    ExitRoutine% = False
    Exit Function
End If
'
gvbExitFlag% = True
'
If PanelText("Structure") <> "" Then
    CloseFile True, False
End If
'
UnloadForms
'
SaveFileList

'
'For lvnCount = 0 To frmPrecisionPlus.Crpt1.Count - 1
'  Unload frmPrecisionPlus.Crpt1(lvnCount).object
'Next
'
If Len(PanelText("Inventory")) > 0 Then
    CloseInventory
End If
'
On Error Resume Next
'
tbRange(0).Close
tbRange(1).Close
dbRange.Close
Set dbRange = Nothing
'
dbsBOM.Close
Set dbsBOM = Nothing
dbFrameDesn.Close
Set dbFrameDesn = Nothing
ReportDB.Close
Set ReportDB = Nothing
gdbLookupDB.Close
Set gdbLookupDB = Nothing

Set dbInventory = Nothing

'
frmPrecisionPlus.tmrClock.Enabled = False
'
ExitRoutine% = True

[LaVolpe]

What is that gvnTerminate flag you are setting? Do you have some Do:Loop or For:Next loop going on that is using that variable to exit? If you do, can you post the code from the end of that loop to the end of the routine containing that loop? If not, how is gvnTerminate being used.

What may be happening and I don't have all the details to make a better guesstimate, is that your form may actually be re-loaded due to a reference to one of its properties or a control on the form, after Query_Unload enters, but before it exits. Do Loops & For Loops that terminate due to a global variable are primary places to look. When the loop terminates, the form is unloaded, but before the routine containing the loop terminates, it checks on one of its control's properties, thus reloading the form.

Oh and a question on your logic in your query_unload routine....
Even when you set Cancel = True, you are still unloading forms? That doesn't sound logical to me?
Also, you are calling the ExitRoutine which has a call to UnloadForms and SaveFileList. If you are unloading a form that SaveFileList references, then the form will be reloaded & that's your problem. Same applies to CloseInventory.

This is yet another potential problem. I assume UnloadForms unloads all forms. But at the end of the routine, you are calling this line: "frmPrecisionPlus.tmrClock.Enabled = False" which will re-load frmPrecisionPlus just to set the tmrClock.Enabled property. Never call a form's property or control after it has been unloaded or it will reload & cause a scenario like you are experiencing.

Recommend unloading forms in one place, either in main form's QueryUnload or Unload as you seem to be doing, or in a cleanup routine like ExitRoutine, but not in both places.

[si_the_geek]

In addition to those points, I recommend that the first line of the actual unloading process (after any "cancel"/"exit") for each form is to disable the timer(s), as they have a tendency to keep the form open.

You can find much more explanation (and example code) of potential issues in the article How should I close my form/program/class? from our Classic VB FAQs (in the FAQ forum)

[BWisinger]

I've tried many different things and still getting the error. I've now also created an entirely new project with a single form with two buttons, a label and a commonDialog object with this code:

Option Explicit



Private Sub cmdOpen_Click()

comdlg.Action = 1

Label1.Caption = "comdlg.FileName = " & comdlg.FileName

End Sub



Private Sub cmdExit_Click()

Unload Me


End Sub

And still when closing the program it remains in the processes.

[si_the_geek]

I just tried that, and it does not have the problem... it seems that somehow you have got a corrupted common dialog control.

Is it any better if you use the code version (such as in post #7) instead?

[BWisinger]

No, I've tried that too with no success. And the commdlg32.ocx is the same as one off of an XP machine where it runs fine. I copied it over as part of trying to determine if the .ocx had some error or was out-of-date.

[BWisinger]

I just tried that, and it does not have the problem... it seems that somehow you have got a corrupted common dialog control.

Is it any better if you use the code version (such as in post #7) instead?

You said you were running Windows 7 as well. Which version? The machine getting the error is running Windows 7 Home Premium 64-bit with an AMD Athlon Processor TF-20.

[si_the_geek]

I'm using Win7 Ultimate 64-bit, which should be exactly the same as far as this is concerned.

I suspect that copying the commdlg32.ocx was a bad idea, as it has various dependencies - some of which are likely to be specific to the version of Windows (and therefore you might have broken something). I haven't distributed it for many years, so I am not aware of the correct way to do it.

[BWisinger]

I did run RegSvr32 on the files after copying but they are now returned to the files that were there originally, but as the error still occurred even then the change back doesn't really matter.

[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.

[Zorger]

Hi BWisinger, I experience the same problem with the navigating. I too program on a pc with XP and the Exe on Windows 7. Could you solve it yet? Or maybe Windows 7 needs an update.

Another thing I thought of in connection with this problem: When installing VB the installer asked years ago if I remember it right, if you want to install network tools to. Because I have no network I did not do that. Could this maybe have influence on the working with commondialog1.save in Windows 7?

[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?

[Ellis Dee]

You mean like:

Dim strFile As String

strFile = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
MsgBox strFile

?

[Nightwalker83]

You mean like:

Dim strFile As String

strFile = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
MsgBox strFile

?

Yeah,

I put:

txtFile.Text = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")

and that worked! I overlooked the Msgbox code you had in the code.

Edit:

How do I test if cancel was clicked?

Never mind! I solved the problem using:

Private Sub cmdAttach_Click()
        Dim sFile As String
    sFile = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    If Not sFile <> "" Then
    Exit Sub
    Else
    txtFile.Text = sFile
   LstFiles.AddItem txtFile.Text
   lblCount.Caption = lblCount.Caption + 1
    End If
End Sub

[akhileshbc]

Private Sub cmdAttach_Click()
    Dim sFile As String
    sFile = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    
    If sFile <> "" Then
        txtFile.Text = sFile
        LstFiles.AddItem txtFile.Text
        lblCount.Caption = val(lblCount.Caption) + 1
    End If
End Sub

.....

[Nightwalker83]

That is a bit smaller!

[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

[Nightwalker83]

Try:

Dim sFile As String
    sFile = ShowOpenDialog(App.Path, "All Files|*.*", "*.*")
    
    If sFile <> "" Then
 'Code here
    End If