获取Windows下载文件夹的路径

Question

我有一些 Excel VBA 代码，需要知道 Downloads 文件夹路径。我怎样才能做到呢？

由于您可以在 Downloads 文件夹（以及 Documents 和大多数文件夹，通过文件夹属性）移动，因此像

%USERPROFILE%

这样的环境变量对于构建像

%USERPROFILE%\Downloads

和

WScript.Shell.SpecialFolders 这样的路径是没有用的

未列出“下载”文件夹。

我想必须通过读取注册表来完成，但我对此一无所知。

谢谢！

Answer 1

简单的解决方案 - 通常有效

这是来自@assylias 的评论。正如其他人提到的，如果用户更改了默认的“下载”位置，它将提供错误的文件夹路径 - 但这很简单。

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

最佳解决方案

发布的答案返回“%USERPROFILE%\Downloads”。我不知道该怎么处理它，所以我创建了下面的函数。这会将其转换为函数并返回实际路径。像这样称呼它：

Debug.Print GetCurrentUserDownloadsPath

或

Debug.Print GetCurrentUserDownloadsPath

。感谢@s_a 展示了如何读取注册表项并使用文件夹路径查找注册表项。

' 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

在谷歌上找到了答案......

读取注册表的方法是，按照http://vba-corner.livejournal.com/3054.html:

'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

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

以及下载文件夹的 GUID，根据 MSDN http://msdn.microsoft.com/en-us/library/windows/desktop/dd378457(v=vs.85).aspx:

{374DE290-123F-4565-9164-39C4925E467B}

因此

RegKeyRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}")

产生当前用户的下载文件夹路径。

Answer 3

读取此类路径的受支持方法是使用

SHGetKnownFolderPath

函数。

我编写了这个 VBA 代码来做到这一点。已在 Excel 2000 中测试过。

它不适用于任何 64 位版本的 Office。我不知道它的 Unicode 恶作剧是否适用于 2000 年以上的 Office 版本。这不太漂亮。

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

Answer 4

要使用尽可能少的代码，您可以 只需在 VBA 中运行此 PowerShell 一行代码即可：

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

有关如何运行 .ps1，请参阅此处

您也可以嵌入单行（但这是一个新主题）。

Answer 5

Sub GetDownloadedFolderFiles()
'
' Keep it simple - Paul Seré
'
Dim fso  As New FileSystemObject
Dim flds As Folders
Dim fls  As Files
Dim f    As File

'Downloads folder for the actual user!

Set fls = fso.GetFolder("C:\Users\User\Downloads").Files 

For Each f In fls
    Debug.Print f.Name
Next

End Sub

Answer 6

为什么不使用正确的 GUID 从注册表读取下载文件夹并将结果与用户配置文件路径混合？

Function RegKeyRead(i_RegKey As String) As String
    
    Dim myWS As Object

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

Public Function Replace(strExpression As Variant, strSearch As String, StrReplace As String) As String

    Dim lngStart As Long
    
    If IsNull(strExpression) Then Exit Function
    
    lngStart = 1
    While InStr(lngStart, strExpression, strSearch) <> 0
        lngStart = InStr(lngStart, strExpression, strSearch)
        strExpression = Left(strExpression, lngStart - 1) & StrReplace & Mid(strExpression, lngStart + Len(strSearch))
        lngStart = lngStart + Len(StrReplace)
    Wend

    Replace = strExpression
    
End Function

Function GetDownloadedFolderPath() As String

    GetDownloadedFolderPath = RegKeyRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}")
    GetDownloadedFolderPath = Replace(GetDownloadedFolderPath, "%USERPROFILE%", Environ$("USERPROFILE"))

End Function