Get the Windows Download folder's path

Question

I have some Excel VBA code that requires knowing the Downloads folder path. How could I do it?

Since you can move around the Downloads folder (and also Documents and most of those folders, via the folder properties), the environmental variables like %USERPROFILE% are useless to construct a path like %USERPROFILE%\Downloads, and WScript.Shell.SpecialFolders doesn't list the Downloads folder.

I guess it has to be done reading the registry, but I'm clueless about that.

Thanks!

Answer 1

Simple Solution - usually works

This is from a comment by @assylias. As others have mentioned it will provide the wrong folder path if the user has changed the default "Downloads" location - but it's simple.

Function GetDownloadsPath() As String
    GetDownloadsPath = Environ$("USERPROFILE") & "\Downloads"
End Function

Best Solution

The posted answer was returning "%USERPROFILE%\Downloads". I didn't know what to do with it so I created the function below. This turns it into a function and returns the actual path. Call it like this: Debug.Print GetCurrentUserDownloadsPath or Debug.Print GetCurrentUserDownloadsPath. Thanks to @s_a for showing how to read a registry key and finding the registry key with the folder path.

' Downloads Folder Registry Key
Private Const GUID_WIN_DOWNLOADS_FOLDER As String = "{374DE290-123F-4565-9164-39C4925E467B}"
Private Const KEY_PATH As String = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\"
'
Public Function GetCurrentUserDownloadsPath()
    Dim pathTmp As String

    On Error Resume Next
    pathTmp = RegKeyRead(KEY_PATH & GUID_WIN_DOWNLOADS_FOLDER)
    pathTmp = Replace$(pathTmp, "%USERPROFILE%", Environ$("USERPROFILE"))
    On Error GoTo 0

    GetCurrentUserDownloadsPath = pathTmp
End Function
'
Private Function RegKeyRead(registryKey As String) As String
' Returns the value of a windows registry key.
    Dim winScriptShell As Object

    On Error Resume Next
    Set winScriptShell = VBA.CreateObject("WScript.Shell")  ' access Windows scripting
    RegKeyRead = winScriptShell.RegRead(registryKey)    ' read key from registry
End Function

Answer 2

To use less code as possible you can Just run this PowerShell one-liner in VBA:

$downloadsFolder = (New-Object -ComObject Shell.Application).NameSpace('shell:Downloads').Self.Path

For how to run the .ps1 see here

You can also embed the one liner (But that's a new topic).

Answer 3

The supported way to read such paths is to use the SHGetKnownFolderPath function.

I wrote this VBA code to do that. It has been tested in Excel 2000.

It won't work in any 64-bit version of Office. I don't know if its Unicode shenanigans will work in versions of Office more recent than 2000. It's not pretty.

Option Explicit

Private Type GuidType
  data1 As Long
  data2 As Long
  data3 As Long
  data4 As Long
End Type

Declare Function SHGetKnownFolderPath Lib "shell32.dll" (ByRef guid As GuidType, ByVal flags As Long, ByVal token As Long, ByRef hPath As Long) As Long
Declare Function lstrlenW Lib "kernel32.dll" (ByVal hString As Long) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMemory As Long)
Declare Sub RtlMoveMemory Lib "ntdll.dll" (ByVal dest As String, ByVal source As Long, ByVal count As Long)

'Read the location of the user's "Downloads" folder
Function DownloadsFolder() As String

' {374DE290-123F-4565-9164-39C4925E467B}
Dim FOLDERID_Downloads As GuidType
    FOLDERID_Downloads.data1 = &H374DE290
    FOLDERID_Downloads.data2 = &H4565123F
    FOLDERID_Downloads.data3 = &HC4396491
    FOLDERID_Downloads.data4 = &H7B465E92
Dim result As Long
Dim hPath As Long
Dim converted As String
Dim length As Long
    'A buffer for the string
    converted = String$(260, "*")
    'Convert it to UNICODE
    converted = StrConv(converted, vbUnicode)
    'Get the path
    result = SHGetKnownFolderPath(FOLDERID_Downloads, 0, 0, hPath)
    If result = 0 Then
        'Get its length
        length = lstrlenW(hPath)
        'Copy the allocated string over the VB string
        RtlMoveMemory converted, hPath, (length + 1) * 2
        'Truncate it
        converted = Mid$(converted, 1, length * 2)
        'Convert it to ANSI
        converted = StrConv(converted, vbFromUnicode)
        'Free the memory
        CoTaskMemFree hPath
        'Return the value
        DownloadsFolder = converted
    Else
        Error 1
    End If
End Function