Environment("USER").Count = 4
Create Duration = 1,5703125 s
1,092s
Environment("USER").Count = 5
Read Duration = -0,4296875 s              Value = test-test-test
0s
Delete Duration = 1,65625 s
2,075s
Environment("USER").Count = 4

Sub ENVIROMENTS_Excel_Sheet() ' создать в текущей книге лист со списоком переменных окружения, их типами и значениями
'   On Error Resume Next
   Dim oSheet As Worksheet, sEnvName$, sEnvVal$, xArr, xItem, iNdex%
   Dim sHeader(): sHeader = Array("Environment Name", "Environment Type", "Environment Value (at this computer)")
   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))   ' заголовки таблицы
   '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))
   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    ' массив - на лист
   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