VB and VBA Users Source Code: Dynamically setting and getting the values of environment variables
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Dynamically setting and getting the values of environment variables
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, April 27, 2005
Hits:
3767
Category:
Windows API
Article:
Below are two routines (and a demo routine) that dynamically set and get/return the value of environment variables. Note, you must use the EnvironmentGet function to return the current value of an environment variable, since the VB "Environ()" function only returns cached values (and cannot be refreshed). Option Explicit Private Declare Function SHSetValue Lib "SHLWAPI.DLL" Alias "SHSetValueA" (ByVal hKey As Long, ByVal pszSubKey As String, ByVal pszValue As String, ByVal dwType As Long, pvData As String, ByVal cbData As Long) As Long Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long 'Purpose : Updates the specified environment variable. 'Inputs : sSettingName The name of the environment variable. ' sSettingValue The new value of the environment variable. ' [bSystemEnvironment] If true sets a system environment variable, ' else sets local user environment variable. 'Outputs : N/A 'Author : Andrew Baker 'Date : 9/Jul/2001 'Notes : Public Sub EnvironmentSet(sSettingName As String, sSettingValue As String, Optional bSystemEnvironment As Boolean = False) Dim lRet As Long Const REG_EXPAND_SZ = 2, HWND_BROADCAST = &HFFFF&, WM_WININICHANGE = &H1A Const HKEY_CURRENT_USER = &H80000001, REG_SZ = 1 Const SHREGSET_FORCE_HKCU = &H1 Const SMTO_ABORTIFHUNG = &H2 Const HKEY_LOCAL_MACHINE = &H80000002 'Set the environment variable for the current process SetEnvironmentVariable sSettingName, sSettingValue If bSystemEnvironment = False Then 'Set the local environment variable for all other processes (via registry) lRet = SHSetValue(HKEY_CURRENT_USER, "Environment", sSettingName, REG_EXPAND_SZ, ByVal CStr(sSettingValue), CLng(LenB(StrConv(sSettingValue, vbFromUnicode)) + 1)) Else 'Set the system environment variable for all other processes (via registry) lRet = SHSetValue(HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Session Manager\Environment", sSettingName, REG_EXPAND_SZ, ByVal CStr(sSettingValue), CLng(LenB(StrConv(sSettingValue, vbFromUnicode)) + 1)) End If 'Send the environment update message (with a 5 sec timeout) Call SendMessageTimeout(HWND_BROADCAST, WM_WININICHANGE, 0, "Environment", SMTO_ABORTIFHUNG, 5000, lRet) End Sub 'Purpose : Replace function for the VB Environ() function. Returns the CURRENT value of ' an environment variable. 'Inputs : sSettingName The name of the environment setting to return the value of. ' [sDefaultValue] The default value to return. 'Outputs : Returns the value of the environment variable, else returns the default value ' if the value was not found. 'Author : Andrew Baker 'Date : 9/Jul/2001 'Notes : Function EnvironmentGet(sSettingName As String, Optional sDefaultValue As String = "") As String Dim lEndPos As Long Dim sBuffer As String * 2048 lEndPos = GetEnvironmentVariable(sSettingName, sBuffer, Len(sBuffer)) If lEndPos > 0 Then 'Setting found, return it's value EnvironmentGet = Left$(sBuffer, lEndPos) Else 'Return the default value EnvironmentGet = sDefaultValue End If End Function 'Demonstration routine 'NOTE VB does not reload the Environment variables if you use the '"Environ" function to return their values. If you change any values, you 'must use the EnvironmentGet function to return the updated values Sub Test() Call EnvironmentSet("Andrew", "Is Ace (" & Now & ")") MsgBox "The value for the environment variable Andrew : " & EnvironmentGet("Andrew") End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
