Главная » Макросы для Excel » Получение списка переменных окружения (функция ENVIRON в VBA)

Получение списка переменных окружения (функция ENVIRON в VBA)

При помощи функции Environ() можно получить значение переменной окружения Windows

 

Этот макрос создаст новую книгу, и выведет в неё список из 31 переменной,
с примерами вызова функции для получения каждого из параметров:

Sub ВывестиПеременныеОкружения()
    On Error Resume Next
    Dim sh As Worksheet, param$
    Application.ScreenUpdating = False: Set sh = Workbooks.Add.Worksheets(1)
    With sh.Range("a1:d1")
        .Value = Array("Номер параметра", "Параметр", "Пример вызова", "Результат (на моём компьютере)")
        For i = 1 To 31
            param$ = Split(Environ(i), "=")(0)
            .Offset(i).Value = Array(i, param$, "env$ = Environ(""" & param$ & """)", Environ(param$))
        Next
    End With
End Sub

 

В результате работы макроса, получается следующая таблица:

Номер параметра Параметр Пример вызова Результат (на моём компьютере)
1 ALLUSERSPROFILE env$ = Environ("ALLUSERSPROFILE") C:\Documents and Settings\All Users
2 APPDATA env$ = Environ("APPDATA") C:\Documents and Settings\Admin\Application Data
3 CLIENTNAME env$ = Environ("CLIENTNAME") Console
4 CommonProgramFiles env$ = Environ("CommonProgramFiles") C:\Program Files\Common Files
5 COMPUTERNAME env$ = Environ("COMPUTERNAME") MYCOMPUTERNAME
6 ComSpec env$ = Environ("ComSpec") C:\WINDOWS\system32\cmd.exe
7 EMAIL env$ = Environ("EMAIL") C:\Documents and Settings\Admin\Application Data\The Bat!
8 FP_NO_HOST_CHECK env$ = Environ("FP_NO_HOST_CHECK") NO
9 HOMEDRIVE env$ = Environ("HOMEDRIVE") C:
10 HOMEPATH env$ = Environ("HOMEPATH") \Documents and Settings\Admin
11 LOGONSERVER env$ = Environ("LOGONSERVER") \\MYCOMPUTERNAME
12 NUMBER_OF_PROCESSORS env$ = Environ("NUMBER_OF_PROCESSORS") 2
13 OS env$ = Environ("OS") Windows_NT
14 Path env$ = Environ("Path") C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem
15 PATHEXT env$ = Environ("PATHEXT") .COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH
16 PROCESSOR_ARCHITECTURE env$ = Environ("PROCESSOR_ARCHITECTURE") x86
17 PROCESSOR_IDENTIFIER env$ = Environ("PROCESSOR_IDENTIFIER") x86 Family 15 Model 107 Stepping 2, AuthenticAMD
18 PROCESSOR_LEVEL env$ = Environ("PROCESSOR_LEVEL") 15
19 PROCESSOR_REVISION env$ = Environ("PROCESSOR_REVISION") 6b02
20 ProgramFiles env$ = Environ("ProgramFiles") C:\Program Files
21 RML env$ = Environ("RML") C:/Rml
22 SESSIONNAME env$ = Environ("SESSIONNAME") Console
23 SystemDrive env$ = Environ("SystemDrive") C:
24 SystemRoot env$ = Environ("SystemRoot") C:\WINDOWS
25 TEMP env$ = Environ("TEMP") C:\DOCUME~1\Admin\LOCALS~1\Temp
26 TMP env$ = Environ("TMP") C:\DOCUME~1\Admin\LOCALS~1\Temp
27 USERDOMAIN env$ = Environ("USERDOMAIN") MYCOMPUTERNAME
28 USERNAME env$ = Environ("USERNAME") Игорь
29 USERPROFILE env$ = Environ("USERPROFILE") C:\Documents and Settings\Admin
30 WecVersionForRosebud.1294 env$ = Environ("WecVersionForRosebud.1294") 4
31 windir env$ = Environ("windir") C:\WINDOWS
  • 26426 просмотров

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
Игорь (администратор сайта), 26 Апр 2017 - 12:24.#1

Внёс исправление в код.
Но макрос и так работал без ошибки (выводил таблицу в новый файл), если код вставлять в стандартный модуль (а не в модуль листа)

Гость, 26 Апр 2017 - 11:38.#2

В макросе небольшая ошибка. Вставляет переменные в текущей книге, а не новой. Добавьте "sh." перед "Range("a1:d1")".

Alex_St, 1 Дек 2016 - 11:51.#3

К стати, Игорь, я с работой с переменными окружения столкнулся совсем недавно, когда пробовал передавать через них небольшие наборы строк для заполнения ListBox между разными приложениями.
Использовать создание/удаление текстового файла, а уж тем более использование именованного диапазона памяти на компе для такой простой задачи мне показалось избыточным. Пот я на переменные окружения и посмотрел.
Передача стрингов через них получается не сложно и устойчиво работает. Вот только удивляют большие задержки при создании переменной и её последующем удалении.
Стал анализировать. При счёте времени по Timer получил не только не повторяющиеся, но и вообще странные результаты. Мало того, что длительность процедур сильно плавает, но при чтении она каким-то образом вообще иногда получается отрицательной!
Для проверки прицепил ещё и счёт времени через API
Длительности процессов, полученные через Timer и GetTickCount получаются разные! Отрицательных значений GetTickCount, правда не даёт, но и нулевые как-то напрягают.
Вот код, который я использовал для проверки длительности:
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub test_ENVIROMENT_READ_WRITE()
Dim sEnvType$: sEnvType = "USER" ' "SYSTEM" [default value can be omitted] | "VOLATILE" | "PROCESS" | "USER"
Dim sEnvName$: sEnvName = "myDATA"
Dim sEnvData$: sEnvData = "test-test-test"
Dim lTimer&, lSysTimer&
With CreateObject("WScript.Shell").Environment(sEnvType)
Debug.Print "Environment(""" & sEnvType & """).Count = " & .Count
lTimer = Timer: lSysTimer = GetTickCount
.Item(sEnvName) = sEnvData ' Create User's Environment
Debug.Print "Create Duration (by Timer) = " & Timer - lTimer & " s" ', "Count = " & .Count
Debug.Print "Create Duration (by Ticker) = " & (GetTickCount - lSysTimer) / 1000 & " s"
Debug.Print "Environment(""" & sEnvType & """).Count = " & .Count
lTimer = Timer: lSysTimer = GetTickCount
sEnvData = .Item(sEnvName) ' Read User's Environment
Debug.Print "Read Duration (by Timer) = " & Timer - lTimer & " s", "Value = " & sEnvData
Debug.Print "Read Duration (by Ticker) = " & (GetTickCount - lSysTimer) / 1000 & " s"
lTimer = Timer: lSysTimer = GetTickCount
.Remove (sEnvName) ' Delete User's Environment
Debug.Print "Delete Duration (by Timer) = " & Timer - lTimer & " s" ', "Count = " & .Count
Debug.Print "Delete Duration (by Ticker) = " & (GetTickCount - lSysTimer) / 1000 & " s"
Debug.Print "Environment(""" & sEnvType & """).Count = " & .Count
Debug.Print "-----------------------------------------"

А вот один из странных результатов, выданный этой процедурой:
Environment("USER").Count = 4
Create Duration (by Timer) = 0,96875 s
Create Duration (by Ticker) = 1,294 s
Environment("USER").Count = 5
Read Duration (by Timer) = -0,03125 s Value = test-test-test
Read Duration (by Ticker) = 0 s
Delete Duration (by Timer) = 2,28515625 s
Delete Duration (by Ticker) = 2,325 s
Environment("USER").Count = 4
-----------------------------------------
Ничего не понимаю!
Даже позавчера топик в Миру создал с вопросом ( http://www.excelworld.ru/forum/10-31360-1?lUoSDm )
Но что-то никто из знатоков этот феномен так и не объяснил.

Alex_St, 1 Дек 2016 - 11:14.#4

Игорь, код рабочий и неоднократно мною проверенный. Об этом можно судить даже потому, что On Error Resume Next во второй строке закомментирован.
А проблема почти наверняка с обращением к функциям листа. Такое у меня когда-то давно на компе тоже возникало. При этом не постоянно, а эпизодически. Как поборол не помню.
А функции ТРАНСП я использовал просто для сокращения кода и не сразу, а на завершающем этапе отладки при наведении красоты.
Изначально просто циклом перечитывал массив.
Восстановил, проверил и причесал вариант с циклом по массиву:

Sub ENVIROMENTS2_Excel_Sheet()   ' создать в текущей книге лист со списоком переменных окружения, их типами и значениями
'   On Error Resume Next
   Dim oSheet As Worksheet, sEnvName$, sEnvVal$, xArr, xItem, iNdex%
   Dim sHeader(): sHeader = Array("Environment Name", "Type", "Value @ " & Environ("COMPUTERNAME") & " [" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "]")
   Dim Arr(): Arr = Array("SYSTEM", "VOLATILE", "PROCESS", "USER")   ' все возможные типы переменных окружения
   Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbTextCompare   ' словарь для сбора данных
   Dim oShell: Set oShell = CreateObject("WScript.Shell")   ' ссылка на объект WScript.Shell
   iNdex = iNdex + 1   ' т.к. sEnvName не уникальны и могут повторяться в разных типах, то как ключ приходится использовать iNdex
   oDict.Add Key:=iNdex, Item:=Array(sHeader(0), sHeader(1), sHeader(2))   ' заголовки таблицы занесены в словарь под ключом iNdex=0
   'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
   For Each xArr In Arr   ' цикл по всем типам переменных
      For Each xItem In oShell.Environment(xArr)   ' цикл по всем переменным данного типа
         sEnvName = Left(xItem, 1) & Split(Mid(xItem, 2), "=")(0)   ' выделить Имя из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
         sEnvName = IIf(Left(sEnvName, 1) = "=", "'", "") & sEnvName   ' патч для предотвращения вычисления формул на листе Excel
         sEnvVal = Split(Mid(xItem, 2), "=", 2)(1)   ' выделить Значение из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
         sEnvVal = IIf(Left(sEnvVal, 1) = "=", "'", "") & sEnvVal   ' патч для предотвращения вычисления формул на листе Excel
         iNdex = iNdex + 1   ' очередной ключ для записи в словарь
         oDict.Add Key:=iNdex, Item:=Array(sEnvName, xArr, sEnvVal)
         'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
      Next xItem
   Next xArr
   xItem = oDict.Items     ' массив значений копируем в массив (напрямую читать из oDict.Items нельзя)
   ReDim Arr(0 To oDict.Count - 1, 0 To 2)    ' для вывода на лист массив массивов необходимо преобразовать в 2D-массив
   For iNdex = 0 To oDict.Count - 1
      Arr(iNdex, 0) = xItem(iNdex)(0)
      Arr(iNdex, 1) = xItem(iNdex)(1)
      Arr(iNdex, 2) = xItem(iNdex)(2)
   Next iNdex
   Application.ScreenUpdating = False: Application.EnableEvents = False
   Set oSheet = ThisWorkbook.Worksheets.Add
   Cells(1, 1).Resize(UBound(Arr, 1) + 1, UBound(Arr, 2) + 1).Value = Arr   ' запись 2D-массива на лист
   Rows("2:2").Select: ActiveWindow.FreezePanes = True: Rows("1:1").Font.Bold = True   ' красота на листе
   With Cells: .EntireColumn.AutoFit: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlBottom: End With
   Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Игорь (администратор сайта), 30 Ноя 2016 - 18:40.#5

Alex_St, код интересный, вот только нерабочий, — вылетает ошибка 13 Type Mismatch на строке «двойное транспонирование вернёт 2D-массив»
Совет: проверяйте код перед публикацией

Alex_St, 30 Ноя 2016 - 17:44.#6

Намного больше переменных выводит процедура:

Sub ENVIROMENTS_Excel_Sheet() ' создать в текущей книге лист со списоком переменных окружения, их типами и значениями
'   On Error Resume Next
   Dim oSheet As Worksheet, sEnvName$, sEnvVal$, xArr, xItem, iNdex%
   Dim sHeader(): sHeader = Array("Environment Name", "Type", "Environment Value (@ " & Environ("COMPUTERNAME") & ")")
   Dim Arr(): Arr = Array("SYSTEM", "VOLATILE", "PROCESS", "USER")   ' все возможные типы переменных окружения
   Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbTextCompare   ' словарь для сбора данных
   Dim oShell: Set oShell = CreateObject("WScript.Shell")   ' ссылка на объект WScript.Shell
   iNdex = iNdex + 1   ' т.к. sEnvName не уникальны и могут повторяться в разных типах, то как ключ приходится использовать iNdex
   oDict.Add Key:=iNdex, Item:=Array(sHeader(0), sHeader(1), sHeader(2))   ' заголовки таблицы занесены в словарь под ключом iNdex=0
   'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
   For Each xArr In Arr   ' цикл по всем типам переменных
      For Each xItem In oShell.Environment(xArr)   ' цикл по всем переменным данного типа
         sEnvName = Left(xItem, 1) & Split(Mid(xItem, 2), "=")(0) ' выделить Имя из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
         sEnvName = IIf(Left(sEnvName, 1) = "=", "'", "") & sEnvName   ' патч для предотвращения вычисления формул на листе Excel
         sEnvVal = Split(Mid(xItem, 2), "=", 2)(1) ' выделить Значение из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
         sEnvVal = IIf(Left(sEnvVal, 1) = "=", "'", "") & sEnvVal   ' патч для предотвращения вычисления формул на листе Excel
         iNdex = iNdex + 1 ' очередной ключ для записи в словарь
         oDict.Add Key:=iNdex, Item:=Array(sEnvName, xArr, sEnvVal)
         'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
      Next xItem
   Next xArr
   With Application.WorksheetFunction ' функция листа ТРАНСП при транспонировании преобразует массив массивов в 2D-массив
      Arr = .Transpose(.Transpose(oDict.Items)) ' двойное транспонирование вернёт 2D-массив, пригодный к прямой передаче в диапазон на листе
   End With
   Application.ScreenUpdating = False: Application.EnableEvents = False
   Set oSheet = ThisWorkbook.Worksheets.Add
   Cells(1, 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr    ' запись 2D-массива на лист
   Rows("2:2").Select: ActiveWindow.FreezePanes = True: Rows("1:1").Font.Bold = True   ' красота на листе
   With Cells: .EntireColumn.AutoFit: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlBottom: End With
   Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

При этом переменные типа User доступны как для чтения, так и для создания/записи

Игорь (администратор сайта), 1 Июл 2014 - 17:10.#7

функция Environ(i) возвращает текст вида
OS=Windows_NT

Split(Environ(i), "=")
разбивает строку на массив из 2 элементов (с индексами 0 и 1): OS и Windows_NT

Потом мы берем элемент с индексом 0 (OS) для вывода в столбец «Параметр»

Гость, 1 Июл 2014 - 11:00.#8

Подскажите, а для чего написано "(0)" в первой строчке цикла?

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
 __        __  ____       _      ____   __        __  ____  
 \ \      / / |  _ \     / \    |  _ \  \ \      / / |  _ \ 
  \ \ /\ / /  | | | |   / _ \   | |_) |  \ \ /\ / /  | | | |
   \ V  V /   | |_| |  / ___ \  |  _ <    \ V  V /   | |_| |
    \_/\_/    |____/  /_/   \_\ |_| \_\    \_/\_/    |____/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.