I would like to be able to have the Excel workbook find the "My
Documents" folder automatically when it is opened. At work we have
changed computers so many times in the last 3 weeks that I am tired of
always having to manually change the address in my macros to point to
the My Documents folder.
Is there a way to program things so it can Find the My Documents folder
automatically? In other words, it would find the My Documents folder
for "Wendy"s desktop when Wendy was logged in, or Toms My Documents
folder when HE is logged in...etc.
The FileSystemObject in the Scripting Runtime Library has a useful
little method called GetSpecialFolder which can return the Windows,
System or Temp folder. But not, alas, the My Documents folder. The
Environ function is another way of getting some settings, though as
far as I know that won't get you the My Documents folder either. (Yes,
I know that an environment variable can be set for that, but that's
going to be as much of a problem as the original one.)
AFAIK the only way to do it reliably is via an API call. If you "get"
API calls, you can fathom what the following does at your leisure. If
you don't, don't worry about it; just copy and paste the following
code into a module, and call the GetMyDocsFolder function whenever you
need to. You don't really NEED to understand what it's doing to use
it.
As an example,
Sub TestGetMyDocs()
MsgBox GetMyDocsFolder
End Sub
will in my case return
C:\Documents and Settings\Hank Scorpio\My Documents
when I'm logged in under my own name rather than one of my other
accounts. It'll return (say) C:\Documents and Settings\Guest2\My
Documents
if I'm logged in on the Guest2 account.
This is, I presume, what you're after. (I'm on Win XP Professional.)
CAUTION! I ripped this out of one of my VB libraries, and had to take
out substantial chunks of error handling and other "bells and
whistles" code from my original procedure. Hopefully I haven't missed
anything, though; I've tested the code below and it does still seem to
work in the same way as the procedure from which it was ripped. Be
careful of any word wrapping issues as well.
--------------------------------------
Option Explicit
'Registry Constants
Private Const HS_RegDT_REG_SZ As Long = 1
Private Const HS_RegRK_HKEY_CURRENT_USER As Long = &H80000001
Private Const HS_RegAM_KEY_QUERY_VALUE As Long = &H1
'----- Registry open / close functions
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hkey As Long) As Long
'----- Registry data reading functions.
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" _
Alias _
"RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExString Lib _
"advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
Function GetMyDocsFolder() As String
'Path to the key that we're interested in.
Const SC_MYDOCS_KEY_PATH As String = _
"Software\Microsoft\Windows\CurrentVersion" _
& "\Explorer\Shell Folders\"
'Key that we're interested in
Const SC_MYDOCS_KEY As String = "Personal"
'Key's handle, populated by the Open Key API call.
Dim h_Key As Long
'Data type returned from the Null query.
Dim l_DataType As Long
'Size of the data stored in the key, returned by the Null query.
Dim l_BufferSize As Long
'The return function value from an API call.
Dim l_APIRetVal As Long
'Returned key value from the Read call.
Dim s_ReturnValue As String
'*************************************************************************
'----- Set default value & enable error handler.
GetMyDocsFolder = ""
On Error GoTo ErrorHandler
'*************************************************************************
'----- Use the Open Key API call to return the handle to h_key.
l_APIRetVal = RegOpenKeyEx(HS_RegRK_HKEY_CURRENT_USER, _
SC_MYDOCS_KEY_PATH, 0, HS_RegAM_KEY_QUERY_VALUE, h_Key)
'----- Do a Null call to get the key type and size.
l_APIRetVal = RegQueryValueExNULL(h_Key, SC_MYDOCS_KEY, _
0&, l_DataType, 0&, l_BufferSize)
'----- Read the string.
If l_DataType = HS_RegDT_REG_SZ Then
'Create a string consisting of null bytes. The length of the
'string equals the length of the Registry entry as determined
'via the buffer value above.
s_ReturnValue = String(l_BufferSize, 0)
l_APIRetVal = RegQueryValueExString(h_Key, SC_MYDOCS_KEY, 0&, _
l_DataType, s_ReturnValue, l_BufferSize)
'Remove trailing null. (Strings returned from API calls are C
'strings, not VB strings. This "converts" them.)
s_ReturnValue = Left$(s_ReturnValue, l_BufferSize - 1)
End If
'*************************************************************************
'Assign returned value to the ApplicationDataDirectory property.
GetMyDocsFolder = s_ReturnValue
ExitPoint:
'Ensure that errors do not result in an endless loop.
On Error Resume Next
RegCloseKey (h_Key)
Exit Function
'*************************************************************************
ErrorHandler:
MsgBox "Error reading the My Documents folder. " _
& "Error No: " & Err.Number _
& vbCrLf & Err.Description
Resume ExitPoint
End Function
