makro na kontrolu klíče v registru windows Vyřešeno

[jiri255]

Předem se omlouvám, že opět přidávám další téma, ale toto už je snad poslední věc co se mi nedaří vytvořit.
Zkoušel jsme hledat všude možně, ale nenašel jsem žádný odkaz na makro, které by toto umělo.
Potřeboval bych poradit s následujícím kódem tedy pokud ovšem lze něco takového vytvořit?
Mělo by to vypadat asi takto:

Kód: Vybrat vše

Prohledej registr windows a pokud najdeš klíč
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RgisteredOwner"
a jeho údaj hodnoty se bude rovnat "jirka" neprováděj nic
v případě, že se nebude rovnat "jirka" tak na list 2 do buňky A1 tuto hodnotu zkopíruj
a zároveň spusť makro "module2.test"


Nejde mi o to ten klíč měnit nebo něco měnit makrem v registru windows to by nebylo rozumné
jde mi jen o to, aby makro zkontrolovalo určitý údaj a pokud souhlasí tak se ukončilo a pokud nesouhlasí,
tak provedlo kopii té hodnoty a spustilo jiné makro, ale bylo by dobré pokud by v tom makru šlo ručně přepsat
jak cestu ke klíči, tak i hodnotu klíče kterou má porovnávat, protože bych to potřeboval čas od času měnit na
různé položky registru.
Předem děkuji za případnou pomoc

[Reklama]

[cmuch]

zkus kouknout tady na to.
http://www.slipstick.com/outlook-develo ... using-vba/

[jiri255]

jo jo tohle vypadá velice dobře jen jsem s toho vyčetl, že to spíše slouží pokud to nenalezne ten klíč k tomu, aby ho to tam vytvořilo
jestli jsem to teda pochopil správně.
Šlo by to nějak překopat pro ten můj výše uvedený účel?
Pokusil bych se o to sám, ale bohužel nemám dostatečné znalosti, abych to makro upravil a nerad bych si pokusem/omylem
zmuchlal registr v počítači

[cmuch]

Ten tvůj klíč u sebe nemám, ale našel jsem čtení názvu PC

Kód: Vybrat vše

Sub Read_registry_Value()
    Dim Shell As Object
    Dim keyname As String
    Dim value As String
    Dim keyvalue As String
 
    keyname = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\" & _
              "Control\ComputerName\ActiveComputerName\"
             
    value = "ComputerName"
 
    Set Shell = CreateObject("wscript.shell")
    On Error Resume Next
    keyvalue = Shell.regread(keyname & value)
    If Err.Number <> 0 Then
        MsgBox "Invalid Registry Entry"
    Else
        MsgBox keyvalue
    End If
    On Error GoTo 0
End Sub

Zkoušel jsem i na jiné klíče a zobrazuje je tak jak jsou v registrech.

[jiri255]

půlka toho makra je OK klíč to najde, ale spíš kdyby to tu hodnotu nezobrazovalo, ale porovnalo s hodnotou zapsanou také
v tom makru a pokud souhlasí, tak se makro ukončí a pokud ta hodnota nebude souhlasit s tou zapsanou v makru, tak se
ta hodnota zkopíruje na list 2 a spustí to další makro např: "Module2.test"
Šlo by to makro takto upravit?

[cmuch]

nahrad část tímto a pouprav

Kód: Vybrat vše

If Err.Number <> 0 Then
        MsgBox "Invalid Registry Entry"
    Else
      If keyvalue = "něco" Then
        'Exit Sub
       Else
        Call nejakemakro
      End If
    End If

[jiri255]

super přesně, tak jsem to myslel, ale dokupy bych to nedal... šlo by tam ještě doplnit, že pokud ta hodnota nebude souhlasit,
tak kromě toho spuštění "nějakého makra" by to tu hodnotu klíče zkopírovalo na list 2 do buňky A1?

[cmuch]

Kód: Vybrat vše

sheets("List2").range("A1") = keyvalue

[jiri255]

díky to je ono a ještě jsem narazil na jeden malý problém, jak jsem přepisoval cestu, tak jsem v ní udělal chybu a to makro se na
té chybě zaseklo: (červeně označené "r")
keyname = "HKEY_LOCAL_MACHINE\SYSTEM\CurrrentControlSet\" & _
"Control\ComputerName\ActiveComputerName\"
a všiml jsem si, že i když je cesta správně, ale nebude existovat klíč, tak to také končí chybou
value = "ComputerName"
Bylo by možné to ošetřit stejným způsobem jako tu hodnotu v klíči?
Tedy, že by to tu kontrolu začalo cestou = pokud se cesta nebude rovnat "nejaka cesta" spusť "nějaké makro" a pokud cesta bude souhlasit,
tak nic nedělej a pokračuj na klíč = pokud se klíč nebude rovnat "nejaky nazev klice", tak opět spusť "nějaké makro", ale pokud bude klíč
souhlasit opět nic nedělej a pokračuj na tu kontrolu hodnoty.

[cmuch]

Já i když udělám chybu v cestě nebo mám neexistující hodnotu tak se makro nikde nezastavilo a končilo hláškou "Invalid Registry Entry".
Prostě makro se chovalo tak jak má.
Nicméně jsem to makro poupravil podle posledního požadavku

Kód: Vybrat vše

Sub Read_registry_Value()
    Dim Shell As Object
    Dim keyname As String
    Dim value As String
    Dim keyvalue As String
 
    keyname = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\" & _
        "Control\ComputerName\ActiveComputerName\"
    value = "ComputerName"
 
    Set Shell = CreateObject("wscript.shell")
    On Error Resume Next
    keyvalue = Shell.regread(keyname & value)
   
    If Err.Number <> 0 Then
        Call nejakemakro2
     Else
      If keyvalue = "něco" Then
        'Exit Sub
       Else
        Sheets("List2").Range("A1") = keyvalue
        Call nejakemakro1
      End If
    End If
    On Error GoTo 0
End Sub

[jiri255]

omlouvám se jj nybyla to vlastně chyba končilo to tou hláškou "Invalid Registry Entry", kterou jsem bral jako chybu,
ale teď je to úplně perfektní.
Děkuji za pomoc