Open Files from Favorites Folder - Excel 2007

[Yevette]

Hello,

I found an old post regarding accessing Favorites in the "Open" dialog box in Excel 2007. It was suggested to browse for Favorites in the "Open" diaglog box, right click in the "look in" area and add Favorites. However, Favorites does not show up anywhere in the Drive / File lists for me. I can access Favorites only via Windows Explorer. Am I doing something wrong? Any help you can provide would greatly be appreciated.

Thank you!

Yevette

 

[Ruddles]

In the VBA editor, go Insert > Module and paste the following code in:-

[FONT=Courier New]Option Explicit[/FONT]
[FONT=Courier New][/FONT] 
[FONT=Courier New]Public Declare Function SHGetSpecialFolderLocation _
    Lib "shell32" (ByVal hWnd As Long, ByVal nFolder As Long, ppidl As Long) As Long[/FONT]
[FONT=Courier New]Public Declare Function SHGetPathFromIDList _
    Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal Pidl As Long, ByVal pszPath As String) As Long[/FONT]
[FONT=Courier New]Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
    
Public Const MAX_PATH = 260
Public Const NOERROR = 0[/FONT]
[FONT=Courier New][/FONT] 
[FONT=Courier New]Public Function SpecFolder(ByVal lngFolder As Long) As String[/FONT]
[FONT=Courier New]  Dim lngPidlFound As Long
  Dim lngFolderFound As Long
  Dim lngPidl As Long
  Dim strPath As String
  
  strPath = Space(MAX_PATH)
  lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
  If lngPidlFound = NOERROR Then
    lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
    If lngFolderFound Then
      SpecFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
    End If
  End If
  CoTaskMemFree lngPidl
  
End Function[/FONT]

This function will return the location of the various system and user folders on your machine. Try it: open the Immediate window (Ctrl-G) and type ?specfolder(6) followed by Enter. Does it report where your Favorites folder is located?

Assuming that worked, add these statements to your existing code:-

[FONT=Courier New]Const CSIDL_FAVORITES = &H6 [COLOR=green]' at the top with your other Dim and Const statements[/COLOR][/FONT]
[FONT=Courier New][/FONT] 
[FONT=Courier New]ChDir SpecFolder(CSIDL_FAVORITES) [COLOR=green]' immediately before the Application.GetOpenFileName[/COLOR]
[/FONT]

Now run your code again. The ChDir should change directory to your Favorites folder and this is where .GetOpenFileName starts its browsing.

The values you need to find some of the other folders are:-

[FONT=Courier New]Const CSIDL_ADMINTOOLS = &H30
Const CSIDL_ALTSTARTUP = &H1D
Const CSIDL_APPDATA = &H1A
Const CSIDL_BITBUCKET = &HA
Const CSIDL_COMMON_ADMINTOOLS = &H2F
Const CSIDL_COMMON_ALTSTARTUP = &H1D
Const CSIDL_COMMON_APPDATA = &H23
Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19
Const CSIDL_COMMON_DOCUMENTS = &H2E
Const CSIDL_COMMON_FAVORITES = &H1F
Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_COMMON_STARTMENU = &H16
Const CSIDL_COMMON_STARTUP = &H18
Const CSIDL_COMMON_TEMPLATES = &H2D
Const CSIDL_CONTROLS = &H3
Const CSIDL_COOKIES = &H21
Const CSIDL_DESKTOP = &H0
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_FAVORITES = &H6
Const CSIDL_FONTS = &H14
Const CSIDL_HISTORY = &H22
Const CSIDL_INTERNET = &H1
Const CSIDL_INTERNET_CACHE = &H20
Const CSIDL_LOCAL_APPDATA = &H1C
Const CSIDL_MYPICTURES = &H27
Const CSIDL_NETHOOD = &H13
Const CSIDL_NETWORK = &H12
Const CSIDL_PERSONAL = &H5
Const CSIDL_PRINTERS = &H4
Const CSIDL_PRINTHOOD = &H1B
Const CSIDL_PROFILE = &H28
Const CSIDL_PROGRAM_FILES = &H26
Const CSIDL_PROGRAM_FILES_COMMON = &H2B
Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
Const CSIDL_PROGRAM_FILESX86 = &H2A
Const CSIDL_PROGRAMS = &H2
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_STARTMENU = &HB
Const CSIDL_STARTUP = &H7
Const CSIDL_SYSTEM = &H25
Const CSIDL_SYSTEMX86 = &H29
Const CSIDL_TEMPLATES = &H15
Const CSIDL_WINDOWS = &H24
[/FONT]

I've included them here in case someone comes across this thread when trying to locate a different folder: this will save them having to look any further.

 

[andreco]

Thank you so much for your posted solution. I had been looking for this for months and I was about to throw the towel. Long live VBA, even under W7. Thanks again.

 

[Ruddles]