q

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Public oReg As Variant
 
Sub qweqweqwe()
 
    strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\FolderTypes"
    
    Set oReg = GetObject("winmgmts://./root/default:StdRegProv")
    
    EnumerateKeys HKEY_LOCAL_MACHINE, strKeyPath
    
End Sub
 
Sub EnumerateKeys(hDefKey, key)
  ActiveCell.Offset(1, 0).Activate
  ActiveCell.Value = key
  oReg.EnumKey hDefKey, key, arrSubKeys
  If Not IsNull(arrSubKeys) Then
  
    EnumerateValues hDefKey, key
  
    For Each subkey In arrSubKeys
      EnumerateKeys hDefKey, key & "\" & subkey
      EnumerateValues hDefKey, key & "\" & subkey
    Next
  End If
End Sub
 
Sub EnumerateValues(hDefKey, strSubKeyPath)
 
  ActiveCell.Offset(1, 0).Activate
  ActiveCell.Value = key
  
  oReg.EnumValues hDefKey, strSubKeyPath, arrValueNames, arrTypes
  
  If Not IsNull(arrValueNames) Then
    i = 0
    For Each subValueName In arrValueNames
      i = i + 1
      Select Case arrTypes(i)
 
      ' Show a REG_SZ value
      '
      Case REG_SZ
        oReg.GetStringValue hDefKey, strSubKeyPath, strValueName, strValue
        Debug.Print "  " & strValueName & " (REG_SZ) = " & strValue
 
      ' Show a REG_EXPAND_SZ value
      '
      Case REG_EXPAND_SZ
        oReg.GetExpandedStringValue hDefKey, strSubKeyPath, strValueName, strValue
        Debug.Print "  " & strValueName & " (REG_EXPAND_SZ) = " & strValue
 
      ' Show a REG_BINARY value
      '
      Case REG_BINARY
        oReg.GetBinaryValue hDefKey, strSubKeyPath, strValueName, arrBytes
        strBytes = ""
        For Each uByte In arrBytes
          strBytes = strBytes & Hex(uByte) & " "
        Next
        Debug.Print "  " & strValueName & " (REG_BINARY) = " & strBytes
 
      ' Show a REG_DWORD value
      '
      Case REG_DWORD
        oReg.GetDWORDValue hDefKey, strSubKeyPath, strValueName, uValue
        Debug.Print "  " & strValueName & " (REG_DWORD) = " & CStr(uValue)
 
      ' Show a REG_MULTI_SZ value
      '
      Case REG_MULTI_SZ
        oReg.GetMultiStringValue hDefKey, strSubKeyPath, strValueName, arrValues
        Debug.Print "  " & strValueName & " (REG_MULTI_SZ) ="
        For Each strValue In arrValues
          Debug.Print "    " & strValue
        Next
 
    End Select
      
      
      
      EnumerateKeys hive, strSubKeyPath & "\" & subValueName
    Next
  End If
  
End Sub
 
'EnumerateKeys HKEY_LOCAL_MACHINE, strKeyPath
 
Sub TestME()
    Dim temp As Object
    Dim strComputer As String
    Dim rPath As String
    Dim arrSubKeys()
    Dim strAsk
 
    strComputer = "."
    Set temp = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
 
    rPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\FolderTypes\"
    temp.EnumKey HKEY_LOCAL_MACHINE, rPath, arrSubKeys
    For Each strAsk In arrSubKeys
        Debug.Print strAsk
    Next
End Sub
 
 
Sub qwe()
    
    Const HKEY_CURRENT_USER = &H80000001
     
    '--- Create object ref to registry
    strComputer = "."
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\default:StdRegProv")
     
    '--- Create string value
    strKeyPath = "Software\Policies\Microsoft\Windows\Control Panel\Desktop"
    oReg.CreateKey HKEY_CURRENT_USER, strKeyPath
      
    '--- Set timeout values in seconds, 600sec=10min
    strValueName = "ScreenSaveTimeOut"
    strValue = CStr("900")                 ' To enable
    'strValue    = cstr("0")               ' To disable
     
    '--- Update registry
    oReg.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
     
    '--- Not Configured
    'oReg.DeleteValue HKEY_CURRENT_USER,strKeyPath,strValueName
 
End Sub