Question

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

由于您可以移动下载文件夹（以及文档以及大部分文件夹，通过文件夹属性），因此可以使用%USERPROFILE%等环境变量构建像%USERPROFILE%\Downloads这样的路径是没用的，WScript.Shell.SpecialFolders没有列出下载文件夹。

我想必须要阅读注册表，但我对此毫无头绪。

谢谢！

Answer 1

找到答案谷歌多一点......

根据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＆＃39; 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 2

阅读此类路径的支持方式是使用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 3

简单解决方案 - 通常可以使用

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

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

最佳解决方案

已发布的答案正在返回＆＃34;％USERPROFILE％\ Downloads＆＃34;。我不知道该怎么做，所以我创建了下面的功能。这会将其转换为函数并返回实际路径。称之为：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 = CreateObject("WScript.Shell")  ' access Windows scripting
    RegKeyRead = winScriptShell.RegRead(registryKey)    ' read key from registry
End Function

Answer 4

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 5

要尽可能少地使用代码，您可以只需在 VBA 中运行这个 PowerShell one-liner：

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

有关如何运行 .ps1 的信息，请参阅 here

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

Answer 6

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

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

获取Windows下载文件夹的路径

6 个答案:

简单解决方案 - 通常可以使用

最佳解决方案