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
Get the Windows Download folder's path
提问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.SpecialFolders
doesn'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 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.
发布的答案返回“%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
回答by arx
The supported way to read such paths is to use the SHGetKnownFolderPath
function.
读取此类路径的受支持方法是使用该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