VBA Modules: modSpecialFolders v1.00a

Read this for full information on these modules

modSpecialFolders reports back the path for a variety of "special folders" from Windows Shell32.  It's fairly standard and extremely useful code, great for deducing where to save output files and such.

This code is copied from Microsoft support site, I've just added my own annotations.

'modSpecialFolders
'v1.00a 2013-07-19 11:55
'always export to \\GBMNCWSA050\BPMpublic\VBA Modules\

'===========================================================================
' modSpecialFolders
'===========================================================================
'   Finds path to various "special folders" in Windows
'   e.g. My Documents, Program Files, Shared Documents, etc.

'===========================================================================
' Additional modules required:
'===========================================================================
'   None

'===========================================================================
' Additional References required:
'===========================================================================
'   None

'===========================================================================
' External applications required:
'===========================================================================
'   None

'=========================================================================
' VERSION HISTORY
'=========================================================================
'   v1.00a  annotations only
'   v1.00   created from source:
'           http://answers.microsoft.com/en-us/office/forum/office_2010-customize/how-2-refer-to-desktop/97eba910-54c9-409f-9454-6d7c8d54d009



Option Explicit

Public Declare Function SHGetSpecialFolderLocation _
                         Lib "shell32" (ByVal hwnd As Long, _
                                        ByVal nFolder As Long, ppidl As Long) As Long

Public Declare Function SHGetPathFromIDList _
                         Lib "shell32" Alias "SHGetPathFromIDListA" _
                             (ByVal Pidl As Long, ByVal pszPath As String) As Long

Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)

'Desktop
Public Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Public Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
Public Const CSIDL_PRINTERS = &H4 'My Computer\Printers
Public Const CSIDL_PERSONAL = &H5 'My Documents
Public Const CSIDL_FAVORITES = &H6 '\Favorites
Public Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
Public Const CSIDL_RECENT = &H8 '\Recent
Public Const CSIDL_SENDTO = &H9 '\SendTo
Public Const CSIDL_BITBUCKET = &HA '\Recycle Bin
Public Const CSIDL_STARTMENU = &HB '\Start Menu
Public Const CSIDL_DESKTOPDIRECTORY = &H10 '\Desktop
Public Const CSIDL_DRIVES = &H11 'My Computer
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood
Public Const CSIDL_NETHOOD = &H13 '\nethood
Public Const CSIDL_FONTS = &H14 'Windows\fonts
Public Const CSIDL_TEMPLATES = &H15
Public Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
Public Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
Public Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
Public Const CSIDL_APPDATA = &H1A '\Application Data
Public Const CSIDL_PRINTHOOD = &H1B '\PrintHood
Public Const CSIDL_LOCAL_APPDATA = &H1C '\Local Settings\Application Data (non roaming)
Public Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
Public Const CSIDL_COMMON_FAVORITES = &H1F
Public Const CSIDL_INTERNET_CACHE = &H20
Public Const CSIDL_COOKIES = &H21
Public Const CSIDL_HISTORY = &H22
Public Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
Public Const CSIDL_WINDOWS = &H24 'Windows Directory
Public Const CSIDL_SYSTEM = &H25 'System Directory
Public Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
Public Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
Public Const CSIDL_PROFILE = &H28 'USERPROFILE
Public Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
Public Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
Public Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
Public Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs\Administrative Tools
Public Const CSIDL_ADMINTOOLS = &H30 '\Start Menu\Programs\Administrative Tools
Public Const CSIDL_CONNECTIONS = &H31 'Network and Dial-up Connections
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Function SpecFolder(ByVal lngFolder As Long) As String
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

Problems with taking ownership / access rights in Windows 7

If you ever suffered the major and incredibly frustrating problems with Windows 7 when moving an NTFS hard disk to a new PC, or reinstalling the OS: the inability to open, delete, take ownership, or amend permissions on files or folders, then look no further than this thread on Microsoft social support forums

Note my post towards the end of that thread, made today, which amends the excellent original instructions provided by ColtWanger (lol) as follows:

I have thousands of files across hundreds of folders that Win7 simply won't allow me to access since I moved the drive from another machine. I have SP1 installed and although I haven't wasted any more time messing with permissions and audit rights I'm still getting the same issues with being denied access when I try to open the files. So I followed Coltwanger's advice above and amended slightly for my needs:

click Start and type CMD
right-click Command Prompt to run as Administrator

in the cmd window, use cd to find the relevant folder or drive root. In my case this required two commands, D: then cd\

First run TAKEOWN to take ownership.

TAKEOWN /F *.* /A /R /D Y
/F *.* processes all files/folders
/R recurs for all subfolders and files
/A takes permission for the Administrators group (I could easily have specified my own username, or omitted this switch, it shouldn't be necessary as I'm running CMD as Administrator anyway but I was wary that the next step might have failed)
/D Y suppresses the confirmation prompts

Then run ICACLS -- I amended with /grant:R to replace all existing permissions. This fixes a bug where unrecognised owners can remain in place. You can manually add extra user permissions via Windows once this is done.

ICACLS D:\* /grant:R baldmosher:F /T

Successfully processed 31380 files, 0 failures. YAAAAAY!!!!


Update 2012-02-08:

I made copies of all the above folders onto a different hard drive, once I got admin access to them, just to make sure that the permissions from my new HomeGroup setup are the default on all the folders. Much easier than trying to second guess Windows and set them yourself using command line options.


Update 2012-08-05: 

Today I realised my wife couldn't access the shares from her laptop.  I thought about adding her to every shared folder, but I figured it was easier to do it properly, and give access to the HomeGroup.

I also realised she didn't have a user ID on this machine, so I had to do that first (making sure the username and password matched the one on her laptop), then the following at command line run as Administrator:

ICACLS D:\* /grant:R HomeUsers:F /T