m_Comments - 1
' Module: mComments
' Subroutines and functions gathered together and tweaked by:
' Trevor Shuttleworth
' Excel Aid
' Trevor@ExcelAid.co.uk
' ================================================================================
' I have gathered together a number of subroutines
' and functions which will display or list the
' various Special Folders.
' I have tried to attribute the sources where I
' know them and/or can remember them.
' If I have not, it was not deliberate or intentional.
' That said, there are a number of variations on a theme.
' For example, the DropBox and Google Drive locations
' are based on the location of the My Documents folder
' The routines listed in the following modules will
' locate the following folders:
' AllUsersDesktop
' AllUsersStartMenu
' AllUsersPrograms
' AllUsersStartup
' Desktop
' Favorites
' Fonts
' MyDocuments
' NetHood
' PrintHood
' Programs
' Recent
' SendTo
' StartMenu
' Startup
' Templates
' System
' Temp
' Windows
' ================================================================================
mAll - 1
' Module: mAll
Option Explicit
' ================================================================================
Public Function SpecialFolderPath(strFolder As String) As String
' Find out the path to the passed special folder. Use one of the following arguments:
' Options For special folders
' AllUsersDesktop
' AllUsersStartMenu
' AllUsersPrograms
' AllUsersStartup
' Desktop
' Favorites
' Fonts
' MyDocuments
' NetHood
' PrintHood
' Programs
' Recent
' SendTo
' StartMenu
' Startup
' Templates
On Error GoTo ErrorHandler
'Create a Windows Script Host Object
Dim objWSHShell As Object
Set objWSHShell = CreateObject("WScript.Shell")
'Retrieve path
SpecialFolderPath = objWSHShell.SpecialFolders(strFolder & "")
' Clean up
Set objWSHShell = Nothing
Exit Function
'**************************************
'* Error Handler
'**************************************
ErrorHandler:
MsgBox "Error finding " & strFolder, vbCritical + vbOKOnly, "Error"
End Function
' ================================================================================
Sub ListAllSpecialFolders()
Dim vArraySF
vArraySF = Array( _
"AllUsersDesktop", _
"AllUsersStartMenu", _
"AllUsersPrograms", _
"AllUsersStartup", _
"Desktop", _
"Favorites", _
"Fonts", _
"MyDocuments", _
"NetHood", _
"PrintHood", _
"Programs", _
"Recent", _
"SendTo", _
"StartMenu", _
"Startup", _
"Templates")
' Choose output sheet
Dim ws As Worksheet: Set ws = Sheets("Sheet5")
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Dim i As Long: i = 1
Dim vSF
With ws
With .Range("A1:B1")
mAll - 2
.Value = Array("Folder", "Special Folder Path")
.Font.Bold = True
End With
For Each vSF In vArraySF
i = i + 1
.Cells(i, 1).Value = vSF
.Cells(i, 2).Value = objSFolders(vSF)
Next 'i
End With
End Sub
' ================================================================================
mOriginal - 1
' Module: mOriginal
' EXCEL, THE WISE WAY
' Get Special Folders Path in VBA
' http://www.xlwise.in/2013/05/get-special-folders-path-in-vba.html
Option Explicit
' ================================================================================
Sub GetSpecialFolderPath_Allx()
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
'Make the result sheet visible if not
Sheets("Sheet1").Select
'Get "My Documents" Path
Sheets("Sheet1").Cells(2, 1).Value = "My Documents"
Sheets("Sheet1").Cells(2, 2).Value = objSFolders("mydocuments")
'Get "Desktop" Path
Sheets("Sheet1").Cells(3, 1).Value = "Desktop"
Sheets("Sheet1").Cells(3, 2).Value = objSFolders("desktop")
'Get "All Users Desktop" Path
Sheets("Sheet1").Cells(4, 1).Value = "All User Desktop"
Sheets("Sheet1").Cells(4, 2).Value = objSFolders("allusersdesktop")
'Get "Recent Documents" Path
Sheets("Sheet1").Cells(5, 1).Value = "Recent Documents"
Sheets("Sheet1").Cells(5, 2).Value = objSFolders("recent")
'Get "Favorites Document" Path
Sheets("Sheet1").Cells(6, 1).Value = "Favorites Document"
Sheets("Sheet1").Cells(6, 2).Value = objSFolders("favorites")
'Get "Programs" Path
Sheets("Sheet1").Cells(7, 1).Value = "Programs"
Sheets("Sheet1").Cells(7, 2).Value = objSFolders("programs")
'Get "Start Menu" Path
Sheets("Sheet1").Cells(8, 1).Value = "Start Menu"
Sheets("Sheet1").Cells(8, 2).Value = objSFolders("StartMenu")
'Get "Send To" Path
Sheets("Sheet1").Cells(9, 1).Value = "Send To"
Sheets("Sheet1").Cells(9, 2).Value = objSFolders("SendTo")
End Sub
' ================================================================================
mRonDeBruin - 1
' Module: mRonDeBruin
Option Explicit
' Courtesy of Ron de Bruin
' Ron de Bruin Excel Automation
' http://www.rondebruin.nl/win/s3/win027.htm
' SpecialFolders and Windows Temp folder
' How do I get the path of a special folder in
' Windows and open the folder?
' Below are two way to get the path of a
' special folder so you can use it in your code.
' ================================================================================
Sub GetSpecialFolder()
'Special folders are : AllUsersDesktop, AllUsersStartMenu
'AllUsersPrograms, AllUsersStartup, Desktop, Favorites
'Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
'SendTo, StartMenu, Startup, Templates
'Get Favorites folder and open it
Dim WshShell As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
SpecialPath = WshShell.SpecialFolders("Favorites")
MsgBox SpecialPath
'Open folder in Explorer
Shell "explorer.exe " & SpecialPath, vbNormalFocus
End Sub
' ================================================================================
Sub VBA_GetSpecialFolder_functions()
'Here are a few VBA path functions
MsgBox Application.Path
MsgBox Application.DefaultFilePath
MsgBox Application.TemplatesPath
MsgBox Application.StartupPath
MsgBox Application.UserLibraryPath
MsgBox Application.LibraryPath
End Sub
' ================================================================================
' Windows Temp folder
'
' Without code you can do this to open the temp folder
'
' Start>Run
' Enter %temp%
' OK
' Or use one of the two code examples
' ================================================================================
Sub GetTempFolder_1()
MsgBox Environ("Temp")
'Open folder in Explorer
Shell "explorer.exe " & Environ("Temp"), vbNormalFocus
End Sub
' ================================================================================
Sub GetTempFolder_2()
Dim FSO As Object, TmpFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set TmpFolder = FSO.GetSpecialFolder(2)
MsgBox TmpFolder
'Open folder in Explorer
Shell "explorer.exe " & TmpFolder, vbNormalFocus
End Sub
' ================================================================================
' 0 = The Windows folder contains files installed by the Windows operating system
' 1 = The System folder contains libraries, fonts, and device drivers
' 2 = The Temp folder is used to store temporary files. Its path is found in the
' TMP environment variable.
mRonDeBruin - 2
' ================================================================================
' Clear the Temp folder
'
' It is smart to delete all files and folders in
' your temp folder at least once a month to avoid problems.
' Important: Do this always after you reboot your system.
'
' Manual you can use this to open the folder and then delete
' all files and folders in the Temp folder.
'
' Start>Run
' Enter %temp%
' OK
'
' It is possible that there are a few files that you can't
' delete but you can skip them and this is no problem.
'
' ================================================================================
mSelective - 1
' Module: mSelective
Option Explicit
' ================================================================================
Sub GetMyDocumentsPath()
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
MsgBox objSFolders(16)
Debug.Print objSFolders(16)
Set objSFolders = Nothing
End Sub
' ================================================================================
Sub GetSpecialFolderPath_DropBox()
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
'Get "DropBox" Path
Debug.Print "My Documents: "; objSFolders("mydocuments")
Debug.Print "Dropbox: "; Replace(objSFolders("mydocuments"), "Documents", "Dropbox")
MsgBox "Dropbox: " & Replace(objSFolders("mydocuments"), "Documents", "Dropbox")
Set objSFolders = Nothing
End Sub
Sub GetSpecialFolderPath_Google_Drive()
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
'Get "Google Drive" Path
Debug.Print "My Documents: "; objSFolders("mydocuments")
Debug.Print "Dropbox: "; Replace(objSFolders("mydocuments"), "Documents", "Google Drive")
MsgBox "Dropbox: " & Replace(objSFolders("mydocuments"), "Documents", "Google Drive")
Set objSFolders = Nothing
End Sub
Sub GetSpecialFolderPath_Selective()
' Choose output sheet
Dim ws As Worksheet: Set ws = Sheets("Sheet2")
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
With ws
With .Range("A1:B1")
.Value = Array("Folder", "Special Folder Path")
.Font.Bold = True
End With
'Get "My Documents" Path
.Cells(2, 1).Value = "My Documents"
.Cells(2, 2).Value = objSFolders("mydocuments")
'Get "Desktop" Path
.Cells(3, 1).Value = "Desktop"
.Cells(3, 2).Value = objSFolders("desktop")
'Get "All Users Desktop" Path
.Cells(4, 1).Value = "All User Desktop"
.Cells(4, 2).Value = objSFolders("allusersdesktop")
'Get "Recent Documents" Path
.Cells(5, 1).Value = "Recent Documents"
.Cells(5, 2).Value = objSFolders("recent")
'Get "Favorites Document" Path
.Cells(6, 1).Value = "Favorites Document"
mSelective - 2
.Cells(6, 2).Value = objSFolders("favorites")
'Get "Programs" Path
.Cells(7, 1).Value = "Programs"
.Cells(7, 2).Value = objSFolders("programs")
'Get "Start Menu" Path
.Cells(8, 1).Value = "Start Menu"
.Cells(8, 2).Value = objSFolders("StartMenu")
'Get "Send To" Path
.Cells(9, 1).Value = "Send To"
.Cells(9, 2).Value = objSFolders("SendTo")
End With
Set objSFolders = Nothing
End Sub
' ================================================================================
Sub GetSpecialFolderPath_Loop()
' Choose output sheet
Dim ws As Worksheet: Set ws = Sheets("Sheet3")
Dim objSFolders As Object
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Dim i As Long
With ws
With .Range("A1:B1")
.Value = Array("Folder", "Special Folder Path")
.Font.Bold = True
End With
For i = 0 To objSFolders.Count - 1
.Cells(i + 2, 2).Value = objSFolders(i)
Next 'i
End With
Set objSFolders = Nothing
End Sub
' ================================================================================
Sub GetSpecialFolderPaths()
' Choose output sheet
Dim ws As Worksheet: Set ws = Sheets("Sheet4")
Dim WshShell As Object
Dim strPath As String
Dim strFolderName As String
Dim intLoop As Integer
Set WshShell = CreateObject("Wscript.Shell")
With ws
With .Range("A1:B1")
.Value = Array("Folder", "Special Folder Path")
.Font.Bold = True
End With
For intLoop = 0 To WshShell.SpecialFolders.Count - 1
strPath = WshShell.SpecialFolders(intLoop)
strFolderName = Mid(strPath, InStrRev(strPath, Application.PathSeparator) + 1, 9999)
.Cells(intLoop + 2, 1) = strFolderName
.Cells(intLoop + 2, 2) = strPath
.Cells(intLoop + 2, 3) = intLoop
Next intLoop
End With
Set WshShell = Nothing
End Sub
' ================================================================================
mTempAndWindows - 1
Option Explicit
' ================================================================================
' There are many ways to get the special folders
' like Systems folder, Temporary folder etc.
' One common method is to use the Environ.
' Here you can achieve the same using
' FileSystemObject
' ================================================================================
Sub Get_Special_Folders()
' Uses the File System Object
' Need to have a reference to
' Microsoft Scripting Runtime
' Tools | References | scroll down and tick | OK
On Error GoTo Show_Err
Dim oFS As FileSystemObject
Dim sSystemFolder As String
Dim sTempFolder As String
Dim sWindowsFolder As String
Set oFS = New FileSystemObject
' System Folder - Windows\System32
sSystemFolder = oFS.GetSpecialFolder(SystemFolder)
' Temporary Folder Path
sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
' Windows Folder Path
sWindowsFolder = oFS.GetSpecialFolder(WindowsFolder)
If Not oFS Is Nothing Then Set oFS = Nothing
Show_Err:
If Err <> 0 Then
MsgBox Err.Number & " - " & Err.Description
Err.Clear
End If
End Sub
' ================================================================================
' Note: For this you need to reference
' Microsoft Scripting Runtime
' ================================================================================
mTheShortVersion - 1
' Module: mTheShortVersion
Option Explicit
' Daily Dose of Excel
' Excel tips and other stuff
' Get the Path to My Documents in VBA
' **** Kusleika
' http://dailydoseofexcel.com/archives/2009/02/26/get-the-path-to-my-documents-in-vba/
' This code coutesy of Mike Alexander
' ================================================================================
Function GetSpecialFolderNames()
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
MsgBox objFolders("desktop")
MsgBox objFolders("allusersdesktop")
MsgBox objFolders("sendto")
MsgBox objFolders("startmenu")
MsgBox objFolders("recent")
MsgBox objFolders("favorites")
MsgBox objFolders("mydocuments")
Set objFolders = Nothing
End Function
' ================================================================================
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks