Inventor 2016 Crash on VBA 7 call to FolderBrowse Win32API. Windows 10.

[Anonymous]

I have a Browse Folder Function that uses the Shell32.dll
to allow the user to browse for a folder.

Autodesk inventor does not have this built into their VBA api.

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long

On 64 bit Windows 7 Pc's running 64 bit inventor it runs perfect.
On 64 bit Windows 10 PC's running 64 bit inventor it crashes on this exact function.

Anyone have a work around or know what might be causing the problem?

We are browsing for a network location.

[Anonymous]

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long

' == Folder Browser flags ==
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_USENEWUI As Long = (BIF_EDITBOX Or BIF_NEWDIALOGSTYLE)
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_NOTRANSLATETARGETS As Long = &H400
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000
Private Const BIF_BROWSEFILEJUNCTIONS As Long = &H10000

Private Const CSIDL_DRIVES As Long = &H11
Private Const WM_USER As Long = &H400
Private Const MAX_PATH As Long = 260

Public Type BrowseInfo
hWndOwner As LongPtr
pIDLRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As LongPtr
lParam As LongPtr
iImage As Long
End Type

'====== Folder Browser for 64 bit VBA 7 ========

Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String
Dim ReturnPath As String

Dim b(MAX_PATH) As Byte
Dim pItem As Long
Dim sFullPath As String
Dim bi As BrowseInfo
Dim ppidl As Long

sInitFolder = CorrectPath(sInitFolder)

' Note VBA windows and dialogs do not have an hWnd property.
bi.hWndOwner = 0 'Windows Main Screen handle.

' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl

bi.pIDLRoot = 0 'ppidl


bi.pszDisplayName = VarPtr(b(0))
bi.lpszTitle = sDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI
If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
bi.lParam = StrPtr(sInitFolder)

pItem = SHBrowseForFolder(bi)     '<----Fails Here on Windows 10.

If pItem Then ' Succeeded
sFullPath = Space$(MAX_PATH)
If SHGetPathFromIDList(pItem, sFullPath) Then
ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
CoTaskMemFree pItem
End If
End If

If ReturnPath <> "" Then
If Right$(ReturnPath, 1) <> "\" Then
ReturnPath = ReturnPath & "\"
End If
End If

FolderBrowse = ReturnPath

End Function

' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Public Function BFFCallback(ByVal Hwnd As LongPtr, ByVal uMsg As LongPtr, ByVal lParam As LongPtr, ByVal sData As String) As LongPtr
If uMsg = BFFM_INITIALIZED Then
SendMessageA Hwnd, BFFM_SETSELECTIONA, True, ByVal sData
End If
End Function

Private Function PtrToFunction(ByVal lFcnPtr As LongPtr) As LongPtr
PtrToFunction = lFcnPtr
End Function

Private Function CorrectPath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
Else
If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root
End If
CorrectPath = sPath
End Function

[wayne.brill]

Hi,

I am not sure why the problem is occurring on Windows 10. (Seems like an issue for Microsoft) I would need to setup a Window's 10 system.

There are some functions in VBA for file and directory access. Could this be a work around?

 This is from the VBA help:

Directories and Files Keyword Summary

Action Keywords
Change directory or folder. ChDir
Change the drive.           ChDrive
Copy a file.                FileCopy
Make directory or folder.   MkDir
Remove directory or folder. RmDir
Rename a file, directory, or folder. Name
Return current path.         CurDir
Return file date/time stamp. FileDateTime
Return file, directory, label attributes. GetAttr
Return file length.          FileLen
Return file name or volume label. Dir
Set attribute information for a file. SetAttr

Here is an example with an update to get files that I tested with. (from the VBA help - not Inventor API)

Public Sub Dir_Test()
 Dim MyPath As String
  Dim MyName As String
  
  'Get the folders in a path:
  ' Display the names in C:\ that represent directories.
MyPath = "c:\"    ' Set the path.
MyName = Dir(MyPath, vbDirectory)    ' Retrieve the first entry.
Do While MyName <> ""    ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If MyName <> "." And MyName <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName    ' Display entry only if it
        End If    ' it represents a directory.
    End If
    MyName = Dir    ' Get next entry.
Loop

  
  'Get files in a path
  MyPath = "C:\TEMP\"    ' Set the path.
  MyName = Dir(MyPath, vbNormal)   ' Retrieve the first entry.
  Do While MyName <> ""    ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If MyName <> "." And MyName <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        'If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName    ' Display entry only if it
        'End If    ' it represents a directory.
    End If
    MyName = Dir    ' Get next entry.
Loop
End Sub

Thanks,

Wayne

[Anonymous]

Thanks for the response Wayne, but no those do not help.  I know a lot about Visual Studio past and present as well as VBA.

The issue is allowing the user to path their way to a particular folder.  The folder may or may not have files in it.

I found the cause of the issue if not a good fix.

There is a Constant that tells the Folder Browser to use the latest UI (User Interface).

Apparently the code recognises Windows 7 browser UI but not Windows 10 browser UI.

If you turn that feature off the Folder Browser code works properly, though with the ugly Windows 98 Browsing UI.

In my code change

bi.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI

to

bi.ulFlags = BIF_RETURNONLYFSDIRS

[Anonymous]

More follow up on this issue detemined a better solution.

All delcare statements used need to return a longlong datatype.

Variables that are set with these return values also have to be of datatype longlong.

The NewUI flag can be added back in with these changes.

---

In 64 bit inventor It is worth of noting that windows 7 64 bit works with long datatype,

but 64 bit windows 10 Requires longlong.

[Anonymous]

Thanks for the post.  Same problem here and you saved me a lot of headaches (you know, aside from the initial one).

[gerrardhickson]

Thanks so much for that advice!

I'm not a code whisperer by any standards, but that was just what I was looking for...