VBA Browse for Folder?

[Legacy 174215]

Hi.

I'm trying to figure out how to get a user to Browse to a folder so I can export a text document into that folder.

Information:
- This needs to work on Office 32bit and Office 64bit Machines
- I want to be able to save to users Desktop

My code was working for Office 32bit, but since some machines are on Office 64bit, the app no longer works.

Current Code for User Desktop Path: (I have added If statement to set PtrSafe) which works for 32bit and 64bit

'<VBA_INSPECTOR_RUN />
Public Const CSIDL_DESKTOP = &H0   ' Desktop (namespace root)
Public Const CSIDL_INTERNET = &H1  ' Internet virtual folder
Public Const CSIDL_PROGRAMS = &H2  ' Programs folder (under Start menu in [user] profile)
Public Const CSIDL_CONTROLS = &H3  ' Control Panel virtual folder
Public Const CSIDL_PRINTERS = &H4  ' Printers virtual folder
Public Const CSIDL_PERSONAL = &H5  ' Personal folder ([user] profile)
Public Const CSIDL_FAVORITES = &H6 ' Favorites folder ([user] profile)
Public Const CSIDL_STARTUP = &H7   ' Startup folder ([user] profile)
Public Const CSIDL_RECENT = &H8    ' Recent Documents folder ([user] profile)
Public Const CSIDL_SENDTO = &H9    ' SendTo folder ([user] profile)
Public Const CSIDL_DESKTOPDIRECTORY = &H10 ' Desktop folder ([user] profile)
Public Const CSIDL_DRIVES = &H11   ' My Computer virtual folder
Public Const CSIDL_NETWORK = &H12  ' Network Neighborhood root
Public Const CSIDL_NETHOOD = &H13  ' Network Neighborhood directory
Public Const CSIDL_FONTS = &H14    ' Fonts virtual folder
Public Const CSIDL_TEMPLATES = &H15 ' Templates folder ([user] profile)
Public Const CSIDL_COMMON_STARTMENU = &H16 ' Start menu (All Users profile)
Public Const CSIDL_COMMON_PROGRAMS = &H17 ' Programs folder (under Start menu in All Users profile)
Public Const CSIDL_COMMON_STARTUP = &H18 ' Startup folder (All Users profile)
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 ' Desktop folder (All Users profile)
Public Const CSIDL_INTERNET_CACHE = &H20    ' Internet Cache folder (Explorer 4.01 and Windows® 98).
Public Const CSIDL_COOKIES = &H21 ' Cookies folder
Public Const CSIDL_HISTORY = &H22 ' History folder
Public Const CSIDL_BITBUCKET = &HA  ' Recycle Bin folder
Public Const CSIDL_STARTMENU = &HB  ' Start menu ([user] profile)
Public Const CSIDL_APPDATA = &H1A ' Application Data ([user] profile) (Internet Explorer 4.0).
Public Const CSIDL_ALTSTARTUP = &H1D ' Alternate Startup ([user], DBCS)
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E ' Alternate Startup folder (All Users profile, DBCS)
Public Const CSIDL_COMMON_FAVORITES = &H1F  ' Favorites folder (All Users profile)
Public Const CSIDL_PRINTHOOD = &H1B ' PrintHood folder ([user] profile)
Public Const CSIDL_MYPICTURES = &H27 ' My Pictures folder (Windows 2000 & Windows Me).
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F ' Administrative tools (All Users profile) (Windows 2000 & Windows Me).
Public Const CSIDL_COMMON_DOCUMENTS = &H2E ' Documents folder (All Users profile)
Public Const CSIDL_ADMINTOOLS = &H30  ' Administrative Tools ([user] profile) (Windows 2000 & Windows Me).
Public Const CSIDL_PROGRAM_FILES = &H26     ' Program Files folder (Windows 2000 & Windows Me).
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B    ' Common Files folder  (Windows 2000 & Windows Me).
Public Const CSIDL_COMMON_APPDATA = &H23 ' Application data for all users. A typical path is C:\Documents and Settings\All Users\Application (Windows 2000 & Windows Me)
Public Const CSIDL_COMMON_TEMPLATES = &H2D ' File system directory that contains the templates that are available to all users. A typical path is C:\Documents and Settings\All Users\Templates. Valid only for Windows NT systems.
Public Const CSIDL_CONNECTIONS = &H31 ' Virtual folder containing Network and Dial-up connetions
Public Const CSIDL_LOCAL_APPDATA = &H1C ' File system directory that serves as a data repository for local (nonroaming) applications. A typical path is C:\Documents and Settings\username\Local Settings\Application Data (Windows 2000 & Windows Me).
Public Const CSIDL_PROFILE = &H28 'User's profile folder (Windows 2000 & Windows Me).
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C ' The x86 Program Files Common folder on RISC systems.
Public Const CSIDL_PROGRAM_FILESX86 = &H2A ' The x86 Program Files folder on RISC systems.
Public Const CSIDL_SYSTEM = &H25 ' System folder. A typical path is C:\WINNT\SYSTEM32 (Windows 2000 & Windows Me).
Public Const CSIDL_SYSTEMX86 = &H29 ' The x86 system directory on RISC systems.
Public Const CSIDL_WINDOWS = &H24 ' Windows directory or SYSROOT. This corresponds to the %windir% or %SYSTEMROOT% environment variables. A typical path is C:\WINNT (Windows 2000 & Windows Me).
Public Const CSIDL_MYMUSIC = &HD ' File system directory that serves as a common repository for music files.
Public Const CSIDL_MYVIDEO = &HE ' File system directory that serves as a common repository for video files.
Public Const CSIDL_COMMON_MUSIC = &H35 ' My Music folder for all users. See CSIDL_MYMUSIC.
Public Const CSIDL_COMMON_PICTURES = &H36 ' My Pictures folder for all users. See CSIDL_MYPICTURES.
Public Const CSIDL_COMMON_VIDEO = &H37 ' My Video folder for all users. See CSIDL_MYVIDEO.
Public Const CSIDL_RESOURCES = &H38 ' System resource directory. A typical path is C:\WINNT\Resources.
Public Const CSIDL_RESOURCES_LOCALIZED = &H39 ' Localized resource directory. See CSIDL_RESOURCES.
Public Const CSIDL_COMMON_OEM_LINKS = &H3A  ' Folder containing links to All Users OEM specific applications.
Public Const CSIDL_CDBURN_AREA = &H3B ' File system folder used to hold data for burning to a CD. Typically [User Profile Folder]\Local Settings\Applications Data\Microsoft\CD Burning.
Public Const CSIDL_COMPUTERSNEARME = &H3D    ' Computers Near Me folder. Virtual folder containing links to "nearby" computers on the network. Nearness it is established by common workgroup membership.
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Type shiEMID
    cb As Long
    abID As Byte
End Type
Public Type ITEMIDLIST
    mkid As shiEMID
End Type

#If VBA7 Then
    Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
    Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
    Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
    Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If


Public Function GetSpecialfolder(CSIDL As Long) As String
    Dim IDL As ITEMIDLIST
    Dim sPath As String
    Dim iReturn As Long
    
    iReturn = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    
    If iReturn = NOERROR Then
        sPath = Space(512)
        iReturn = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
        sPath = RTrim$(sPath)
        If Asc(Right(sPath, 1)) = 0 Then sPath = Left$(sPath, Len(sPath) - 1)
        GetSpecialfolder = sPath
        Exit Function
    End If
    GetSpecialfolder = ""
End Function

Sub GetPath()
  desk = GetSpecialfolder(CSIDL_DESKTOP)
  MsgBox desk

End Sub

My current code works if I select the User's Desktop (which uses the code above_ but if I select any other folder say D:\test I get

Run-time error '91':

Which I believe means the variable hasn't been declared?

Here is the code I'm using to SelectFolders (everything but user's Desktop_

'<VBA_INSPECTOR_RUN />
Option Explicit

Private shlShell As Shell32.Shell
Private shlFolder As Shell32.Folder '////////////////CHECK THIS////////////
Private shlFolderItem As Shell32.FolderItem
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_ShowAllObjects = &H8       'ReturnFSAncestors. This will give you typical root view
                                            'XP has My Computer, My Network Places not seen on 2000
Public Const BIF_editbox = &H10             'Show active selection, allows manual input

Public Function SelectFolder() As String

    Set shlShell = New Shell32.Shell

    Set shlFolder = shlShell.BrowseForFolder(0, "Select a destination folder", _
        BIF_RETURNONLYFSDIRS + BIF_ShowAllObjects)
        
    If shlFolder Is Nothing Then
        SelectFolder = ""
        Exit Function
    End If
    If shlFolder = "Desktop" Then
      'Get User desktop path
      SelectFolder = GetSpecialfolder(CSIDL_DESKTOP)
      SelectFolder = SelectFolder + "\"
      'MsgBox SelectFolder
    Else
        Set shlFolderItem = shlFolder.Items.Item(0)

        '<VBA_INSPECTOR>
        '   <REMOVED>
        '       <MESSAGE>Potentially contains removed items in the object model</MESSAGE>
        '       <ITEM>[mso]ScopeFolder.Path</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </REMOVED>
        '</VBA_INSPECTOR>
        
        SelectFolder = shlFolderItem.Path
        SelectFolder = Left(SelectFolder, InStrRev(SelectFolder, "\"))
    End If

End Function

It stops at

SelectFolder = shlFolderItem.Path

(Note this now happens on both 32bit and 64bit Office)


Anyone have suggestions for this simple task of selecting a folder?

 

[Legacy 174215]

I have done some more testing and have found the following:

My current code works for the following:
- Selecting User's Desktop = OK
- Selecting User's C (System) Drive = OK
- Selecting User's folder within C:\ Drive ie. C:\test = NOT WORKING
- Selecting User's Second drive ie. D:\ = NOT WORKING
- Selecting User's Desktop Folder outside Excel VBA folder ie. C:\Users\USERNAME\Desktop\CurrentExcelFileFolder\NewTestFolder = NOT WORKING

I get the following Error:

Run-time error '91':

Which I believe means the variable hasn't been declared?

 

[GTO]

I am currently in xl2000/XP, so doubt of any help, but curious about:

    Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
    Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

That turns red as soon as I paste it into the module. I have only seen (and until someone shows different, believe) that to declare a function, it must be:

Declare Function FunctionName Lib LibraryName [optional alias](args)

Does this not turn red for you?

 

[Legacy 174215]

I got it from for Office 64bit:
http://msdn.microsoft.com/en-us/library/ee691831.aspx

 

[GTO]

Hi Viper,

Apologies, my bad. I should have surfed before asking that. I see that PtrSafe and the declarations can only be used in vb7. I did find: http://www.jkp-ads.com/articles/apideclarations.asp

but by your link you have probably already downloaded the help topics. Sorry about that.

As mentioned, I'm currently in 2000, but in later versions isn't there a folderpicker (something like that) dialog that can be used?

Mark

 

[Legacy 174215]

This works for Office 32bit and Office 64bit, tested on Windows 7 64bit machines.

Public Function UseFolderDialogOpen() As String
    Dim lngCount As Long

    ' Open the folder dialog
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        ' Set Current Folder Path
        For lngCount = 1 To .SelectedItems.Count
            UseFolderDialogOpen = .SelectedItems(lngCount)
        Next lngCount
        
    End With

End Function

 

[GTO]

It looks like that worked for you, good! Plus, if memory serves correctly, SHBrowseForFolder won't allow going "uphill" of the folder initialized at.

 

[MPW]

Question for viper04:

I liked your example. How would I go about setting the default path? Is there a way?

 

[Legacy 174215]

If the path is always the same and you don't need to choose it, just set the path to a variable.