获取Windows下载文件夹的路径

Question

获取Windows下载文件夹的路径

14

我有一些需要知道下载文件夹路径的Excel VBA代码。我该如何做呢?

由于您可以在文件夹属性中移动下载文件夹（也是文档和大多数文件夹），所以环境变量(例如 %USERPROFILE%)无法构建像 %USERPROFILE%\Downloads这样的路径，而 WScript.Shell.SpecialFolders不会列出下载文件夹。

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

谢谢！

- s_a

2

"C:\Users" & Environ("UserName") & "\Downloads" ？ - Dmitry Pavliv

2

整个问题的重点在于，像文档文件夹和许多其他文件夹一样，下载文件夹可以放在任何地方。虽然用户配置文件始终位于 c:\Users\simoco，但是文档文件夹可以轻松移动到 d:\stuff。 - s_a

1

@DmitryPavliv 或者更简单的方式：Environ("USERPROFILE") & "\Downloads" - 但这并不能回答问题，因为用户可能会重命名他的下载文件夹。 - assylias

7个回答

11

多在谷歌上查找，就能找到答案...

根据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

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

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

因此，RegKeyRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}")可获取当前用户的下载文件夹路径。

- s_a

这会返回“%USERPROFILE%\Downloads”，而 VBA 无法理解。 - Jon Peltier

@JonPeltier 我甚至不记得这个问题，但我取消了答案的接受，因为你的评论。 - s_a

6

读取这样的路径的支持方式是使用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

- arx

2

为了尽可能少地使用代码，您可以在VBA中运行此PowerShell单行命令进行操作： $downloadsFolder = (New-Object -ComObject Shell.Application).NameSpace('shell:Downloads').Self.Path 关于如何运行 .ps1 文件，请参见这里。

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

- alainQtec

0

以上的注册表或其他解决方案都是不必要的。即使“我的文档”被重定向到OneDrive，以下的方法也能解决问题：

Function GetMyDocuments() As String
Dim oWSHShell As Object

Set oWSHShell = CreateObject("WScript.Shell")
GetMyDocuments = oWSHShell.SpecialFolders("MyDocuments")
Set oWSHShell = Nothing
End Function

或者获取桌面文件夹：

Function GetDesktop() As String
Dim oWSHShell As Object

Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
Set oWSHShell = Nothing
End Function

经过尝试、测试，确实有效。

- Richard

0

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

- Paul Seré

1

虽然这段代码片段可能解决了问题，但包括解释真的有助于提高您的帖子质量。请记住，您正在为未来的读者回答问题，而这些人可能不知道您的代码建议原因。 - Dr Rob Lang

1

使用“FileSystemObject”比调用更繁琐的API方法要容易得多。GetFolder中的“C:\Users\User\Downloads”参数指示当前用户的下载文件夹。 - Paul Seré

@Si8 你可能需要发布一个单独的问题。OP的问题特别涉及Windows。 - ChrisB

3

这个答案是错误的，因为用户下载文件夹的位置和名称可以是任何东西。用户可能已经移动了它，用户可能已经重命名了它。它可能存在于完全不同的驱动器上。找到文件夹位置的唯一正确方法是通过SHGetKnownFolderPath和相关API。 - antiduh

0

为什么不使用正确的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

- Xceeded

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ChrisB · Accepted Answer

简单解决方案 - 通常有效

这是来自@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