Environment

You might need to know about your computer's environment, for example the computer's name or the user's name..

These procedures are designed to help you find that information.

Please ..

Please let me know if it's useful, or what changes or amendments you think could be made.

'' ***************************************************************************
'' Purpose : Returns the String associated with a named operating system environment variable.
'' Written : Andy Wiggins, Byg Software Limited
''
Sub GetEnviron()

    MsgBox Environ("ComputerName") & vbCrLf & _
        Environ("UserName") & vbCrLf & _
        Environ("TEMP") & vbCrLf & _
        Environ("windir") & vbCrLf & _
        Environ("COMSPEC") & vbCrLf & _
        Environ("SystemDrive")

End Sub

'' ***************************************************************************
'' Purpose : List the current environment to the immediate window
'' Written : Andy Wiggins, Byg Software Limited
''
Sub GetEnviron()
Dim lStr_EnvString As String
Dim lLng_Indx As Long

    lLng_Indx = 1
    Do
        lStr_EnvString = Environ(lLng_Indx)
        Debug.Print lLng_Indx, lStr_EnvString
        lLng_Indx = lLng_Indx + 1
    Loop Until lStr_EnvString = ""

End Sub

'' ***************************************************************************
'' Purpose : Find the contents of part of the environment
'' Written : Andy Wiggins, Byg Software Limited
'' Use     : GetEnvironF("Path")
''
Function GetEnvironF(pStr_Val As String)
Dim lStr_EnvString As String
Dim lLng_Indx As Long
Dim lLng_Len As Long

lLng_Indx = 1

    Do
        lLng_Len = Len(pStr_Val) + 1
        lStr_EnvString = Environ(lLng_Indx)

        If UCase(Left(Environ(lLng_Indx), lLng_Len)) = UCase(pStr_Val & "=") Then
            GetEnvironF = lStr_EnvString
            Exit Function
        End If

        lLng_Indx = lLng_Indx + 1

    Loop Until lStr_EnvString = ""

    GetEnvironF = ""

End Function

Finally, here's some code that uses an API. Copy all this code and paste it into a VBA module:

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

Public Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long
 

'' - - - - - - - - - - - - - - - - - -
Function OSUserName() As String
Dim Buffer As String * 256
Dim BuffLen As Long
    BuffLen = 256
    If GetUserName(Buffer, BuffLen) Then OSUserName = Left(Buffer, BuffLen - 1)

End Function
 

'' - - - - - - - - - - - - - - - - - -
Function OSMachineName() As String
Dim Buffer As String * 256
Dim BuffLen As Long
Dim lngX As Long
Dim strCompName As String
    BuffLen = 255
    If GetComputerName(Buffer, BuffLen) Then OSMachineName = Left(Buffer, BuffLen)

End Function

-

Published: 17-Jun-2004
Last edited: 05-Jun-2005 19:28