Multiple Apps

Resolve System Environment Variables in FilePath

Ease of Use

Easy

Version tested with

2003, 2007 

Submitted by:

Oorang

Description:

Resolves a Filepath containing a system environment variable to an explicit path. Example: "%SYSTEMROOT%\Fonts" Outputs: "C:\WINDOWS\Fonts" 

Discussion:

In many implementations of file system methods you can use a system environment variable in the path to allow for user specified folders. For example if you type "%USERPROFILE%\My Documents" in the Windows run box you will be taken to your My Documents folder. However not all the methods exposed to VBA involving file paths will resolve paths that contain system environment variables. A notable example of this is the Microsoft Scripting Runtime. This procedure will translate such paths to resolved paths (Ex:"C:\Documents And Settings\Oorang\My Documents") so they can be used with the methods that only accept resolved paths. 

Code:

instructions for use

			

Option Explicit Option Base 0 'Setting this to True will turn off all error handling: #Const m_blnErrorHandlersOff_c = False Public Sub TestResolveEnvironmentVariables() '--------------------------------------------------------------------------- ' Procedure : TestResolveEnvironmentVariables ' Author : Aaron Bush ' Date : 05/29/2008 ' Purpose : Demonstrate ResolveEnvironmentVariables procedure. ' Input(s) : None ' Output(s) : None ' Remarks : Displays several example input/output combinations. Simply ' run procedure: ' Revisions : '--------------------------------------------------------------------------- 'Constants used for display messages: Const strInpt_c As String = vbNewLine & vbNewLine & vbTab & "Input:" & _ vbNewLine & vbTab & vbTab Const strOtpt_c As String = vbNewLine & vbTab & "Output:" & vbNewLine & _ vbTab & vbTab Const strTtlM_c As String = "ResolveEnvironmentVariables Procedure " & _ "Demonstration" Const strTtl1_c As String = "Demonstrate normal resolution:" & strInpt_c Const strTtl2_c As String = "Demonstrate default behavior for not " & _ "found variables:" & strInpt_c Const strTtl3_c As String = "Demonstrate alternate behavior for not " & _ "found variables:" & strInpt_c Dim strInpt As String Dim strOtpt As String 'Conditionally invoke error handler: #If Not m_blnErrorHandlersOff_c Then On Error GoTo Err_Hnd #End If 'Demonstrate normal resolution: strInpt = "%USERPROFILE%\%COMPUTERNAME%\Tada.yay" strOtpt = ResolveEnvironmentVariables(strInpt) MsgBox strTtl1_c & strInpt & strOtpt_c & strOtpt, vbInformation, strTtlM_c 'Demonstrate default behavior for not found variables: strInpt = "%USERPROFILE%\%Foo%\Tada.yay" strOtpt = ResolveEnvironmentVariables(strInpt) MsgBox strTtl2_c & strInpt & strOtpt_c & strOtpt, vbInformation, strTtlM_c 'Demonstrate alternate behavior for not found variables: strInpt = "%USERPROFILE%\%Foo%\Tada.yay" strOtpt = ResolveEnvironmentVariables(strInpt, True) MsgBox strTtl3_c & strInpt & strOtpt_c & strOtpt, vbInformation, strTtlM_c Exit Sub '******* Error Handler ******* Err_Hnd: MsgBox Err.Description, vbSystemModal, "Error: " & Err.Number End Sub Public Function ResolveEnvironmentVariables( _ ByVal value As String, _ Optional ByVal resolveEmpty As Boolean = False) As String '--------------------------------------------------------------------------- ' Procedure : ResolveEnvironmentVariables ' Author : Aaron Bush ' Date : 05/28/2008 ' Purpose : Searches for any Environment variable in a string and returns ' a string with the variable replaced by its value. ' Input(s) : value - The string that contains System Environment ' variables. ' resolveEmpty - Setting this option to false will cause not ' found variables to be removed from string. ' Output(s) : The parsed value. If an error is thrown then unaltered string ' is returned. If a variable is not found then by default it ' will be left in the string. ' Remarks : To aid in debugging, if a Variable is not found the variable ' will remain in the string by default. You can suppress this ' behavior with the resolveEmpty parameter. ' Revisions : 05/29/2009 Aaron Bush Added resolveEmpty parameter. '--------------------------------------------------------------------------- Const lngStep2_c As Long = 2 Const lngLwrBnd_c As Long = 1 Const strDlmtr_c As String = "%" Dim strSgts() As String Dim strVarVal As String Dim strRtnVal As String Dim lngIndx As Long 'Conditionally invoke error handler: #If Not m_blnErrorHandlersOff_c Then On Error GoTo Err_Hnd #End If 'Split value into segments: strSgts = Split(value, strDlmtr_c) 'If "%" present every other value starting with Element 1 will be the name 'of an environment variable: For lngIndx = lngLwrBnd_c To UBound(strSgts) Step lngStep2_c 'The Environ method throws an error if passed an empty string. Test 'string for length before attempting Environ method: If LenB(strSgts(lngIndx)) Then 'Get value of Var: strVarVal = Environ$(strSgts(lngIndx)) 'Only keep value if value found. This makes it easier to debug: If LenB(strVarVal) Then strSgts(lngIndx) = strVarVal ElseIf resolveEmpty Then strSgts(lngIndx) = strVarVal Else 'If value not found, rebuild variable it remains in string: strSgts(lngIndx) = strDlmtr_c & strSgts(lngIndx) & strDlmtr_c End If End If Next 'Rejoin segments into string: strRtnVal = Join(strSgts, vbNullString) '******* Exit Procedure ******* Exit_Proc: 'Suppress Error Handling to Prevent Error-Loops: On Error Resume Next 'Clear Objects: Erase strSgts 'Set Return Value: ResolveEnvironmentVariables = strRtnVal Exit Function '******* Error Handler ******* Err_Hnd: 'Restore original value: strRtnVal = value MsgBox Err.Description, vbSystemModal, "Error: " & Err.Number 'Return to Exit Procedure: Resume Exit_Proc End Function

How to use:

  1. From an Office Application press Alt-F11 to launch the VBE (Visual Basic Editor)
  2. In the VBE, from the "Insert Menu" select "Module" to create a new standard module.
  3. Place code in newly created module.
  4. From the VBE's "Tools" menu select "Macros"
  5. Select "TestResolveEnvironmentVariables" and click "Run"
 

Test the code:

  1. From an Office Application press Alt-F11 to launch the VBE (Visual Basic Editor)
  2. In the VBE, from the "Insert Menu" select "Module" to create a new standard module.
  3. Place code in newly created module.
  4. From the VBE's "Tools" menu select "Macros"
  5. Select "TestResolveEnvironmentVariables" and click "Run"
 

Sample File:

No Attachment 

Approved by mdmackillop


This entry has been viewed 81 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express