What now, VB6 Code?

Well I needed to locate a personal directory for users working via Citrix where all of the user processes are running on the same server. This preclude my using a directory associated with the application as all of the users would be working with the same one. An obvious choice is the “My Documents” folder for each user although it does have it’s snags. While locating this folder using VB.NET is pretty trivial getting the same value from the Registry using VB Classic and the Windows API takes a bit of setting up (plus some trawling through the registry) even if the code itself is pretty short.

So, in case anyone else wants to locate the My Documents folder using Visual Basic (VB) 6 – here is the code:

Caution – while this code only reads from the Windows Registry using the Win32 API any interaction with the Registry does have it’s risks – so go careful.

First you need to declare some functions and constants:

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

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
    
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 Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1                         ' Unicode nul terminated string
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const ERROR_NONE As Long = 0
Private Const ERROR_KEY_DOES_NOT_EXIST As Long = 2

but the actual code for reading the key can be simplified to:

Private Sub GetMyDocsPath()
    Dim RegKey As String,   sValue As String

    Dim lRetVal As Long, lHandle As Long, iType As Long, iLength As Long   
   
    RegKey = "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\SHELL FOLDERS"
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, RegKey, 0, KEY_READ, lHandle)
    If lRetVal = ERROR_NONE Then
        lRetVal = RegQueryValueExNULL(lHandle, "PERSONAL", 0, iType, 0, iLength)
        If lRetVal = ERROR_NONE And iType = REG_SZ Then
            sValue = String(iLength, 0)
            lRetVal = RegQueryValueExString(lHandle, "PERSONAL", 0, iType, sValue, iLength)
            If lRetVal = ERROR_NONE Then
                MyDocPath = Left(sValue, iLength - 1) & "\"
            End If
        End If
        RegCloseKey lHandle
    End If
End Sub