browse for folder

[JimMuglia]

Greetings,

A while ago someone gave me this function for browsing for a folder. It works great for me on my machine. The problem is, that when I install the program on our customer's 98 machine, the "Choose a folder box" does not appear when she clicks the button; and then she has to enter the folder name manually.

Any idea why it acts that way on her machine, and how I can fix the problem?

The code is below.

Thank you,
Jim

Private Sub cmdDirectoryBrowse_Click()
Dim i, flag As Integer
Dim sAnswer(50) As String
i = 0
flag = 1
sAnswer(i) = " " & BrowseForFolder("Choose a folder!", 0, 0)
lstDirectoriesToScan.AddItem (sAnswer(i))
While flag = 1
If MsgBox("Would you like an additional directory to be scanned?", vbYesNo) = vbYes Then
'Yes was selected
i = i + 1
sAnswer(i) = " " & BrowseForFolder("Choose a folder!", 0, 0)
lstDirectoriesToScan.AddItem (sAnswer(i))
Else
'No was selected
flag = 0
End If
Wend
dircount = lstDirectoriesToScan.ListCount
End Sub

[leinad31]

What's the code for BrowseForFolder()?

[JimMuglia]

Function BrowseForFolder(ByVal pstrPrompt, _
ByVal pintBrowseType, _
ByVal pintLocation)
On Error Resume Next

Dim ShellObject As Object
Dim pstrTempFolder As Variant
Dim clngColonPosition As Variant
Const NO_PARENT = &H0

Set ShellObject = CreateObject("Shell.Application")

Set pstrTempFolder = ShellObject.BrowseForFolder(NO_PARENT, pstrPrompt, _
pintBrowseType, pintLocation)

BrowseForFolder = pstrTempFolder.ParentFolder.ParseName( _
pstrTempFolder.Title).PATH

If Err.Number <> 0 Then
BrowseForFolder = Null

'--Handles cancel
If Err.Number = 424 Then
Set ShellObject = Nothing
Set pstrTempFolder = Nothing
Exit Function
End If

'--If the user selects a drive, the drive letter is converted to
'--a path by adding a colon and backslash to the drive letter.
clngColonPosition = InStr(1, pstrTempFolder.Title, ":", vbTextCompare)
If clngColonPosition > 0 Then
BrowseForFolder = Mid(pstrTempFolder.Title, (clngColonPosition - 1), 2) & "\"
End If
End If

Set ShellObject = Nothing
Set pstrTempFolder = Nothing

End Function

[JimMuglia]

So... any clues why the Browse box doesn't show on our customer's 98 machine; but it shows on ours?

[peet]

The object can probably not be created


this

'--Handles cancel
If Err.Number = 424 Then
Set ShellObject = Nothing
Set pstrTempFolder = Nothing
Exit Function
End If

tells if the object is created or not.... try removing it and run on the 98 computer.

it it errs, the problem is that there are some files missing....

also try the api version of browse for folder

Option Explicit
 
Public Type BrowseInfo
     hwndOwner As Long
     pIDLRoot As Long
     pszDisplayName As Long
     lpszTitle As Long
     ulFlags As Long
     lpfnCallback As Long
     lParam As Long
     iImage As Long
End Type
 
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_NEWDIALOGSTYLE = &H40
 
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
     
    'declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo
 
    'initialise variables
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
     End With
 
    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(udtBI)
     
    'get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If
 
    'If cancel was pressed, sPath = ""
     BrowseForFolder = sPath
 
End Function
 
 
'usage : 
Private Sub Form_Click()
    MsgBox BrowseForFolder(Me.hWnd, "select folder")
End Sub

think that should work...