vba 获取 Windows 下载文件夹的路径

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/23070299/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 18:07:09  来源:igfitidea点击:

Get the Windows Download folder's path

windowsvbaexcel-vbawindows-shellwsh

提问by s_a

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

我有一些需要知道下载文件夹路径的Excel VBA 代码。我怎么能做到?

Since you can move around the Downloadsfolder (and also Documentsand 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.SpecialFoldersdoesn't list the Downloads folder.

由于您可以移动Downloads文件夹(以及Documents和大多数这些文件夹,通过文件夹属性),因此环境变量(例如 )%USERPROFILE%对于构建类似 的路径没有用%USERPROFILE%\Downloads,并且WScript.Shell.SpecialFolders不会列出 Downloads 文件夹。

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

我想它必须完成阅读注册表,但我对此一无所知。

Thanks!

谢谢!

回答by s_a

Found the answer google a little more...

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

The way to read the registry is, as per http://vba-corner.livejournal.com/3054.html:

读取注册表的方法是,根据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

And the GUID for the Downloads folder, as per MSDN's http://msdn.microsoft.com/en-us/library/windows/desktop/dd378457(v=vs.85).aspx:

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

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

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

Thus RegKeyRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}")yields the current user's Downloads folder path.

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

回答by ChrisB

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.

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

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 GetCurrentUserDownloadsPathor Debug.Print GetCurrentUserDownloadsPath. Thanks to @s_a for showing how to read a registry key and finding the registry key with the folder path.

发布的答案返回“%USERPROFILE%\Downloads”。我不知道如何处理它,所以我创建了下面的函数。这将它变成一个函数并返回实际路径。像这样称呼它:Debug.Print GetCurrentUserDownloadsPathDebug.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

回答by arx

The supported way to read such paths is to use the SHGetKnownFolderPathfunction.

读取此类路径的受支持方法是使用该SHGetKnownFolderPath函数。

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

我写了这个 VBA 代码来做到这一点。它已经在 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.

它不适用于任何 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

回答by Paul Seré

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