VB实时错误91

Question

Private Sub Command1_Click()
     Dim a As New Shell32.Shell
     Dim b As folder
     Set b = a.BrowseForFolder(0, "选择文件夹", 0)
     Dim str As String
     str = b.Items.Item.Path
End Sub先在projects菜单下的references中把Microsoft Shell Controls And Automation勾上。然后运行时指定路径到桌面或者按了取消按钮就报实时错误91，指定别的路径确定均不报错，请问高手该怎么改一下？

Answer 1

  Dim i As Integer
  
  For i = 0 To b.Items.Count - 1
    Debug.Print b.Items.Item(i).Path
  Next 

Answer 2

Private Sub Command1_Click()
  Dim a As New Shell32.Shell
  Dim b As folder
  On Error Resume Next
  Set b = a.BrowseForFolder(0, "选择文件夹", 0)
  Dim str As String
  str = b.Items.Item.Path
End Sub

Answer 3

    If Not b Is Nothing Then
        If Not b.Items.Item Is Nothing Then str = b.Items.Item.Path
    End If

Answer 4

http://tieba.baidu.com/f?tn=bdAdvResult&kw=&ct=352321536&lm=65541&rs5=1&rs2=2&sn=vb&word=BrowseForFolder&un=cbm666&rs1=0&rn=10

Answer 5

除了取消有错，哪还有错？取消你捕获一下
Private Sub Command1_Click()
  Dim a As New Shell32.Shell
  Dim b As Folder
  Set b = a.BrowseForFolder(0, "选择文件夹", 0)
  Dim i As Integer
  
  For i = 0 To b.Items.Count - 1
    Debug.Print b.Items.Item(i).Path
  NextEnd Sub

Answer 6

Option ExplicitPrivate Type BROWSEINFO    hOwner   As Long
    pidlRoot   As Long
    pszDisplayName   As String
    lpszTitle   As String
    ulFlags   As Long
    lpfn   As Long
    lParam   As Long
    iImage   As LongEnd TypePrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
'Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As LongPrivate Const MAX_PATH = 260Private Const BFFM_INITIALIZED = 1
Private Const WM_USER = &H400
'Private Const BFFM_SETSTATUSTEXTA   As Long = (WM_USER + 100)
'Private Const BFFM_SETSTATUSTEXTW   As Long = (WM_USER + 104)
'Private Const BFFM_ENABLEOK         As Long = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
'Private Const BFFM_SETSELECTIONW    As Long = (WM_USER + 103)Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const lPtr = (LMEM_FIXED Or LMEM_ZEROINIT)Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_USENEWUI = &H40
'Private Const BIF_STATUSTEXT = &H4
Private Const BIF_EDITBOX = &H10'-------------------------------------------
' 目录选择窗(允许指定初始目录)
'-------------------------------------------
Public Function BrowseForFolder(Optional ByVal hWndOwner As Long, Optional ByVal sTitle As String = "请选择文件夹：", Optional ByVal sSelPath As String = "c:\", Optional NewFolder As Boolean = False) As String    Dim BI        As BROWSEINFO
    Dim pidl      As Long
    Dim lpSelPath As Long
    Dim sPath     As String * MAX_PATH    If Len(sSelPath) > 0 Then sSelPath = Replace(sSelPath & "\", "\\", "\")    With BI
        .hOwner = hWndOwner
        .pidlRoot = 0
        .lpszTitle = sTitle
        .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
    
        lpSelPath = LocalAlloc(lPtr, Len(sSelPath))
        MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
    
        .lParam = lpSelPath
        .ulFlags = IIf(NewFolder, BIF_USENEWUI, BIF_RETURNONLYFSDIRS) Or BIF_EDITBOX    End With    pidl = SHBrowseForFolder(BI)    If pidl Then
        If SHGetPathFromIDList(pidl, sPath) Then
            BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
        End If        Call CoTaskMemFree(pidl)
    End If    Call LocalFree(lpSelPath)    'If   cancel   was   pressed,   sPath   =   ""
    If Len(BrowseForFolder) > 0 Then
        BrowseForFolder = Replace(BrowseForFolder & "\", "\\", "\")
    End IfEnd FunctionPrivate Function BrowseCallbackProcStr(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long    Select Case uMsg        Case BFFM_INITIALIZED
            Call SendMessage(hwnd, BFFM_SETSELECTIONA, 1, ByVal StrFromPtrA(lpData))            'Call PostMessage(hwnd, BFFM_SETSELECTIONA, 1, ByVal StrFromPtrA(lpData))
        Case Else
    End SelectEnd FunctionPrivate Function FARPROC(ByVal pfn As Long) As Long    FARPROC = pfn
    
End FunctionPrivate Function StrFromPtrA(ByVal lpszA As Long) As String    Dim sRtn As String
    sRtn = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal sRtn, ByVal lpszA)
    StrFromPtrA = sRtnEnd Function