Sub ENVIRION_Excel_Sheet()   ' создать в текущей книге лист со списоком переменных окружения
   On Error Resume Next
   Dim sh As Worksheet, i%, sEnvName$, sHeader()
   Dim sLastName$: sLastName = "windows_tracing_logfile"
   sHeader = Array("index", "Environment Value", "Value @ " & Environ("COMPUTERNAME") & " [" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "]")
   Application.ScreenUpdating = False: Set sh = ThisWorkbook.Worksheets.Add
   With Cells(1, 1).Resize(1, UBound(sHeader) + 1)
       .Value = sHeader
     For i = 1 To 63
         sEnvName$ = Split(Environ(i), "=")(0)   ' Environ(i) возвращает текст типа OS=Windows_NT
         .Offset(i).Value = Array(i, sEnvName$, Environ(sEnvName$))
         If sEnvName = sLastName Then Exit For
      Next
   End With
   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
End Sub

Sub ENVIROMENTS_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
   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

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

Option Explicit
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 = " & Timer - lTimer & " s"   ', "Count = " & .Count
Debug.Print (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 = " & Timer - lTimer & " s", "Value = " & sEnvData
Debug.Print (GetTickCount - lSysTimer) / 1000 & "s"
      lTimer = Timer: lSysTimer = GetTickCount
      .Remove (sEnvName)   ' Delete User's Environment
Debug.Print "Delete Duration = " & Timer - lTimer & " s"   ', "Count = " & .Count
Debug.Print (GetTickCount - lSysTimer) / 1000 & "s"
Debug.Print "Environment(""" & sEnvType & """).Count = " & .Count
   End With
End Sub