问使用SHBrowseForFolderA选择文件夹在windows 10平台上不起作用

EN

    'API Declares
    Public Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd   As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As BrowseInfo) As Long
    Private Declare PtrSafe Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
    Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)



    Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sPath 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

  sPath = CorrectPath(sPath)

  bi.hWndOwner = 0 'Screen.ActiveForm.hwnd

  'SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl

  bi.pIDLRoot = 0 'ppidl

  bi.pszDisplayName = VarPtr(b(0))
  bi.lpszTitle = sDialogTitle
  bi.ulFlags = BF_Flags.BIF_RETURNONLYFSDIRS + BF_Flags.BIF_NEWDIALOGSTYLE + BF_Flags.BIF_STATUSTEXT              'BIF_RETURNONLYFSDIRS
  'bi.ulFlags = BF_Flags.BIF_RETURNONLYFSDIRS + BF_Flags.BIF_USENEWUI + BF_Flags.BIF_STATUSTEXT             'BIF_RETURNONLYFSDIRS

  If FolderExists(sPath) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
  bi.lParam = StrPtr(sPath)



  pItem = SHBrowseForFolderA(bi)

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

'  If pItem <> 0 Then ' Succeeded
'    sFullPath = Space$(MAX_PATH_Unicode)
'    If SHGetPathFromIDListW(pItem, StrPtr(sFullPath)) Then
'      ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
'      CoTaskMemFree pItem 'nettoyage
'    End If
'  End If

  If Right$(ReturnPath, 1) <> "\" And ReturnPath <> "" Then  'Could be "C:"
    FolderBrowse = ReturnPath & "\"
  End If

'If Right$(ReturnPath, 1) <> "\" And ReturnPath <> "" Then  'Could be "C:"
'    FolderBrowse = ReturnPath & "\"
'  End If

End Function