Wie kann man per VBA einen Reg-Schlüssel erzeugen (Access 2003)? (Für Abschaltung der Hyperlink-Sicherheitsmeldung)

25/08/2008 - 13:39 von Nikhil Milo | Report spam
Hallo EntwicklerInnen,

ich möchte per VBA die Hyperlink-Warnmeldung ausschalten. Das
funktioniert schon prinzipiell aber zuvor möchte ich den
noch nicht vorhandenen Registrierungsschlüssel "Security"
per VBA erzeugen (nicht manuell mit Neu etc).

Wie geht dies?


Das Setzen/Ändern dieses Schlüssels mache ich (anschliessend) über
Aufruf einer Bat-Datei, welche ihrerseits eine Reg-Datei mit etwa
folgendem Inhalt aufruft:

[HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Security]
"DisableHyperlinkWarning"=dword:00000001

Für entsprechende Hinweise danke ich Euch im voraus.

Schönen Gruß
Nikhil Milo
 

Lesen sie die antworten

#1 Ingi70
25/08/2008 - 13:55 | Warnen spam
ich möchte per VBA die Hyperlink-Warnmeldung ausschalten. Das
funktioniert schon prinzipiell aber zuvor möchte ich den
noch nicht vorhandenen Registrierungsschlüssel "Security"
per VBA erzeugen (nicht manuell mit Neu etc).

Wie geht dies?
Nikhil Milo



Hallo Nikhil, (cooler Name)

Hab mal das Modul clsRegistry angehangen. Damit kannste in Registry
schreiben und lesen.

Gruß Ingo v. Itter
-

Option Compare Database
Option Explicit
'Achtung: Bei Verwendung von /Decompile -
' /Decompile enthàlt einen Fehler, der bewirkt, daß danach manchmal
' ein Klassenmodul zwar noch so aussieht wie eines, aber keines mehr
ist.
' Es hilft nur: Text des ehemaligen Klassenmoduls kopieren, ehemaliges
Klassenmodul
' löschen und ein neues Klassenmodul unter dem gleichen Namen
erzeugen.

'Übernahme aus der Winapi

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000

' Reg Key Security Options
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Const REG_SZ = 1
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0&
Const REG_OPTION_NON_VOLATILE = 0

Const MaxItemLength = 200

Dim key As Long 'Handle auf den aktuellen Schlüssel

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As
Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As
Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal
cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As
Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long,
ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES,
phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias
"RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

'==Private Function Öffnen(ByVal Pfad As String, pkey As Long) As Boolean
'Ermittle den gewünschten Knoten und öffne ihn
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' key = Schlüssel auf den Pfad
'Rückgabewert: Erfolg (true) oder Fehlschlag (false) der Operation

Öffnen = (RegOpenKeyEx(HKEY_LOCAL_MACHINE, Pfad, 0, KEY_ALL_ACCESS,
pkey) = ERROR_SUCCESS)

End Function 'Öffnen

'==Public Function Lesen(ByVal Pfad As String, ByVal verweis As String)
As Variant
'Lese aus der Registy einen String. Die Funktion bezieht immer auf die
Gruppe
'HKEY_LOCAL_MACHINE.
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' Verweis = Bezeichnung des Verweis, welcher gelesen werden
soll
'Rückgabewert: Die Funktion liefert den Wert des Verweises zurück.
Kann dieses nicht
' ermittelt werden, wird NULL zurückgeliefert.

Dim rw As String * MaxItemLength

Lesen = Null
If Öffnen(Pfad, key) Then 'Der Verweis konnte ermittelt und geöffnet
werden
If RegQueryValueEx(key, verweis, 0, REG_SZ, ByVal rw,
MaxItemLength) = ERROR_SUCCESS Then
Lesen = CutNullTermStr(rw)
End If
Call RegCloseKey(key)
End If

End Function 'Lesen

'=Public Function Schreiben(ByVal Pfad As String, ByVal verweis As
String, ByVal Wert As String) As Boolean
'Schreibe in eine Registrierungseintrag einen neuen Wert hinein.
Sollte der Registrierungs-
'eintrag fehlen, so wird er erzeugt. Es können allerdings keinen neuen
Schlüssel erzeugt
'werden. Es können mit dieser Funktion nur Zeichenketten in die
Registrierung aufgenommen
'werden.
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' Verweis = Bezeichnung des Verweises, welches geschrieben
werden soll
' Wert = Wert, welcher in das Item eingetragen werden
soll
'Rückgabewert: Erfolg (true) oder Fehlschlag (false) der Operation

Schreiben = False
If Öffnen(Pfad, key) Then 'Der Schlüssel konnte ermittelt und
geöffnet werden
Schreiben = (RegSetValueEx(key, verweis, 0, REG_SZ, ByVal Wert,
Len(Wert)) = ERROR_SUCCESS)
Call RegCloseKey(key)
End If

End Function 'Schreiben

'=Public Function Löschen(ByVal Pfad As String, ByVal verweis As String)
As Boolean
'Lösche einen Eintrag aus der Registry. Dieser Eintrag steht Ordner,
'welcher mit Pfad übergeben wird und hat den Namen name.
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' Verweis = Bezeichnung des Verweises, welches gelöscht
werden soll
'Rückgabewert: Erfolg (true) oder Fehlschlag (false) der Operation

Löschen = False
If Öffnen(Pfad, key) Then 'Der Schlüssel konnte ermittelt und
geöffnet werden
Löschen = (RegDeleteValue(key, verweis) = ERROR_SUCCESS)
Call RegCloseKey(key)
End If

End Function 'Löschen

'==Public Function Schlüssel_Erzeugen(ByVal Pfad As String, ByVal
Schlüssel As String) As Boolean
'Diese Funktion legt einen neuen Schlüssel in der Registry an.
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' Schlüssel = Name des zu erzeugenden Schlüssels
'Rückgabewert: Erfolg (true) oder Fehlschlag (false) der Operation

Dim secatt As SECURITY_ATTRIBUTES
Dim disp As Long

Schlüssel_Erzeugen = False
If Öffnen(Pfad, key) Then 'Der Schlüssel konnte ermittelt und
geöffnet werden
Schlüssel_Erzeugen = (RegCreateKeyEx(key, Schlüssel, 0, "",
REG_OPTION_NON_VOLATILE, 0, secatt, 0, disp) = ERROR_SUCCESS)
Call RegCloseKey(key)
End If

End Function 'Schlüssel_Erzeugen

'=Public Function Schlüssel_Löschen(ByVal Pfad As String, ByVal
Schlüssel As String) As Boolean
'Löscht einen Schlüssel aus der Registry. Es werden auch alle
eventuell vorhandenen
'Eintràge des Schlüssel gelöscht.
'ACHTUNG! Es werden auch alle vorhandenen Unterschlüssel gelöscht.
'Parameter: Pfad = Registrierungspfad, in dem sich der gewünschte
Verweis befindet
' Schlüssel = Name des zu löschenden Schlüssels
'Rückgabewert: Erfolg (true) oder Fehlschlag (false) der Operation

Schlüssel_Löschen = False
If Öffnen(Pfad, key) Then 'Der Schlüssel konnte ermittelt und
geöffnet werden
Schlüssel_Löschen = (RegDeleteKey(key, Schlüssel) = ERROR_SUCCESS)
Call RegCloseKey(key)
End If

End Function 'Schlüssel_Löschen

Private Function CutNullTermStr(ByVal S As String) As String
'Einige API-Funktionen geben einen Null-terminierten String
'zurück. Diese Funktion schneidet die nachfolgenden Nullen
'ab.

Dim i As Integer

i = 1
While i < Len(S) And Asc(Mid(S, i, 1)) <> 0
i = i + 1
Wend
CutNullTermStr = Left(S, i - 1)

End Function 'CutNullTermStr

Ähnliche fragen