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