[RESOLVED] VB Crashes when Open Dialog (GetOpenFileNameW) is initialised...

[some1uk03]

Hello,

Rather than using the Common Dialog, I created it to a Function through API's.

The dialog works fine, without a prob, but it seems like once it is initialised (opened), then when the form unloads VB always crashes.

Is this something to do with it not releasing some handle properly ?
Heres the code. Note: This is the UniCode aware version GetOpenFileNameW

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long

Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4

Private Type OPENFILENAME
  lStructSize       As Long
  hWndOwner         As Long
  hInstance         As Long
  lpstrFilter       As Long
  lpstrCustomFilter As Long
  nMaxCustFilter    As Long
  nFilterIndex      As Long
  lpstrFile         As Long
  nMaxFile          As Long
  lpstrFileTitle    As Long
  nMaxFileTitle     As Long
  lpstrInitialDir   As Long
  lpstrTitle        As Long
  flags             As Long
  nFileOffset       As Integer
  nFileExtension    As Integer
  lpstrDefExt       As Long
  lCustData         As Long
  lpfnHook          As Long
  lpTemplateName    As Long
End Type

Public Function cDlgShowOpen(ByVal InitialDir As String, ByVal DialogTitle As String, ByVal Filter As String, ByVal FrmhWnd As Long) As String
On Error GoTo ErrFound

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFile As String
Dim FileFilter As String

        strFile = String(512, 0)
        OpenFile.lStructSize = Len(OpenFile)
        OpenFile.hWndOwner = FrmhWnd
        OpenFile.hInstance = App.hInstance
        
          FileFilter = Replace(Filter, "|", vbNullChar)
          If AscW(Right$(FileFilter, 1)) <> 0& Then FileFilter = FileFilter & vbNullChar
        OpenFile.lpstrFilter = StrPtr(FileFilter)
        OpenFile.nFilterIndex = 1
        
        OpenFile.lpstrFile = StrPtr(strFile) 'String(257, 0)
        OpenFile.nMaxFile = Len(strFile)
        
        OpenFile.lpstrFileTitle = StrPtr(OpenFile.lpstrFile)
        OpenFile.nMaxFileTitle = StrPtr(OpenFile.nMaxFile)
        OpenFile.lpstrInitialDir = StrPtr(InitialDir)
        OpenFile.lpstrTitle = StrPtr(DialogTitle)
        OpenFile.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
'Cancel Button Pressed
Else
   cDlgShowOpen = Left$(strFile, InStr(strFile, vbNullChar) - 1)
   'cDlgShowOpen = Replace(OpenFile.lpstrFile, vbNullChar, "")
End If

Exit Function
ErrFound:
cDlgShowOpen = ""
End Function

[DrUnicode]

Missing last 3 elements of Private Type OPENFILENAME.
Try this:

Private Type OPENFILENAME
   lStructSize          As Long     'Length of structure, in bytes
   hwndOwner            As Long     'Window that owns the dialog, or NULL
   hInstance            As Long     'Handle of mem object containing template (not used)
   lpstrFilter          As Long     'File types/descriptions, delimited with vbnullchar, ends with 2xvbnullchar
   lpstrCustomFilter    As Long     'Filters typed in by user
   nMaxCustFilter       As Long     'Length of CustomFilter, min 40x chars
   nFilterIndex         As Long     'Filter Index to use (1,2,etc) or 0 for custom
   lpstrFile            As Long     'Initial file/returned file(s), delimited with vbnullchar for multi files
   nMaxFile             As Long     'Size of Initial File long  , min 256
   lpstrFileTitle       As Long     'File.ext excluding path
   nMaxFileTitle        As Long     'Length of FileTitle
   lpstrInitialDir      As Long     'Initial file dir, null for current dir
   lpstrTitle           As Long     'Title bar of dialog
   Flags                As Long     'See OFN_Flags
   nFileOffset          As Integer  'Offset to file name in full path, 0-based
   nFileExtension       As Integer  'Offset to file ext in full path, 0-based (excl '.')
   lpstrDefExt          As Long     'Default ext appended, excl '.', max 3 chars
   lCustData            As Long     'Appl defined data for lpfnHook
   lpfnHook             As Long     'Pointer to hook procedure
   lpTemplateName       As Long     'Template Name (not used)
   pvReserved           As Long     'new Win2000 / WinXP members
   dwReserved           As Long     'new Win2000 / WinXP members
   FlagsEx              As Long     'new Win2000 / WinXP members
End Type

[si_the_geek]

Is there a particular reason that you are ignoring errors?

What you have got is only marginally better than bad usage of On Error Resume Next, and that is only because you don't run any more code after the error has occurred.

At an absolute minimum you should have debug code in the error handler, eg:

...
Exit Function
ErrFound:
  Debug.Print "Error " & Err.Number & ": " & Err.Description
  Debug.Assert False  'error occurred - check the Immediate window!
  cDlgShowOpen = ""
End Function

However, it would be better to show the error to the user too - as that way they wont just be wondering why nothing has happened, and complaining to you that it doesn't work (without any option of giving you the details that you need to fix it).

[some1uk03]

DrUnicode: That seems to have fixed the crashing for now... Thanks

si_the_geek: Is there a particular reason that you are ignoring errors?

I do actually have a global error checking routine, but I just deleted it in the post (to make the code seem shorter..)

+

When the crash occurs, no error messages appear. Its just a total close of VB.