How to set up a macro prompt when setting the Office 2003 program startup - Set the security level

xiaoxiao2021-04-04  247

'Author: 9CBS her husband' Homepage: jjweb.126.com'MSN: Coderxu # hotmail.com'QQ: 19030300 'reproduced please keep the article intact, save more author information please cherish the fruits of labor of others

How to use VB to set the Office 2003 program to start macro! Click on the menu [Tool (T)] - [Macro (M)] - [Security (s)]. Of course, how is this code settings .. ' Set the registry (not available at runtime): '[HKEY_CURRENT_USER / SOFTWARE / Microsoft / Office / 11.0 / Access / Security]' "level" = 1 // Low '"level" = 2 //' "Level" = 3 // High 'The following code how to set the key value of the registry

Option Explicit 'Directly calls setAccessMacro to set the' Sub Main () '' function in "HKEY_CURRENT_USER / SOFTWARE" in the registry, and established a value in it, and delete the establishment of '' after display. value, if you want to see results RegEdit, the last two sentences may be '' removed, but remember to manually delete the key established 'CreateNewKey HKEY_CURRENT_USER, "Software / SubKey1 / SubKey2"' SetKeyValue HKEY_CURRENT_USER, "Software / SubKey1 / SubKey2 "," Test "," This is just a test ", REG_SZ 'MsgBox QueryValue (HKEY_CURRENT_USER," Software / SubKey1 / SubKey2 "," Test ")' DeleteValue HKEY_CURRENT_USER," Software / SubKey1 / SubKey2 "," Test " 'DeleteKey HKEY_CURRENT_USER, "Software / SubKey1 / SubKey2" 'End SubGlobal Const REG_SZ As Long = 1Global Const REG_DWORD As Long = 4Global Const HKEY_CLASSES_ROOT = & H80000000Global Const HKEY_CURRENT_USER = & H80000001Global Const HKEY_LOCAL_MACHINE = & H80000002Global Const HKEY_USERS = & H80000003Global Const ERROR_NONE = 0Global Const ERROR_BADDB = 1Global Const ERROR_BADKEY = 2Global const error_cantopen = 3global const error_cantread = 4Global const error_cantwrite = 5Global const error_Outof MEMORY = 6Global Const ERROR_INVALID_PARAMETER = 7Global Const ERROR_ACCESS_DENIED = 8Global Const ERROR_INVALID_PARAMETERS = 87Global Const ERROR_NO_MORE_ITEMS = 259Global Const KEY_ALL_ACCESS = & H3FGlobal Const REG_OPTION_NON_VOLATILE = 0Declare Function RegCloseKey _ Lib "advapi32.dll" (ByVal hKey As Long) As LongDeclare 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, _ ByVal lpSecurityAttributes As Long, _ phkResult As Long, _ lpdwDisposition As Long) As LongDeclare 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 LongDeclare Function RegqueryValueexString _ lib "advapi32.dll" _ alias "regqueryvalueexa" (byval HKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ ByVal lpData As String, _ lpcbData As Long) As LongDeclare Function RegQueryValueExLong _ Lib "advapi32.dll" _ Alias ​​"RegQueryValueExA"

(ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Long, _ lpcbData As Long) As LongDeclare Function RegQueryValueExNULL _ Lib "advapi32.dll" _ Alias ​​"RegQueryValueExA" ( ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ ByVal lpData As Long, _ lpcbData As Long) As LongDeclare Function RegSetValueExString _ Lib "advapi32.dll" _ Alias ​​"RegSetValueExA" ( BYVAL RESERVALUENAME AS STRING, _ BYVAL RESERVALUENAME As String, _ Byval DWT ype As Long, _ ByVal lpValue As String, _ ByVal cbData As Long) As LongDeclare Function RegSetValueExLong _ Lib "advapi32.dll" _ Alias ​​"RegSetValueExA" (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ BYVAL DWTYPE As Long, _ LPValue As Long, _ Byval Cbdata As Long AS Longprivate Declare Function RegdeleTeKey & _ LIB "Advapi32.dll" _ alias "regdeletekeya"

(ByVal hKey As Long, _ ByVal lpSubKey As String) Private Declare Function RegDeleteValue & _ Lib "advapi32.dll" _ Alias ​​"RegDeleteValueA" (ByVal hKey As Long, _ ByVal lpValueName As String) Public Function DeleteKey (lPredefinedKey As Long, _ sKeyName As String) Dim lRetVal As Long Dim hKey As Long lRetVal = RegOpenKeyEx (lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) lRetVal = RegDeleteKey (lPredefinedKey, sKeyName) RegCloseKey (hKey) End Function

Public Function DeleteValue (lPredefinedKey As Long, _ sKeyName As String, _ sValueName As String) Dim lRetVal As Long Dim hKey As Long lRetVal = RegOpenKeyEx (lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) lRetVal = RegDeleteValue (hKey, sValueName) RegCloseKey ( HKEY) END FUNCTION

Public Function SetValueEx (ByVal hKey As Long, _ sValueName As String, _ lType As Long, _ vValue As Variant) As Long Dim lValue As Long Dim sValue As String Select Case lType Case REG_SZ sValue = vValue SetValueEx = RegSetValueExString (hKey, sValueName, 0 &, LTYPE, SVALUE, LEN (SVALUE)) Case REG_DWORD LVALUE = VVALUE SETVALUEEX = RegSetValueExlong (HKEY, SVALUENAME, 0 & LTYPE, LVALUE, 4) End Selectens Function

Function QueryValueEx (ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long Dim cch As Long Dim lrc As Long Dim lType As Long Dim lValue As Long Dim sValue As String On Error GoTo QueryValueExError lrc = RegQueryValueExNULL (lhKey, szValueName , 0 &, lType, 0 &, cch) If lrc <> ERROR_NONE Then Error 5 Select Case lType Case REG_SZ: sValue = String (cch, 0) lrc = RegQueryValueExString (lhKey, szValueName, 0 &, lType, sValue, cch) If lrc = ERROR_NONE Then vValue = Left $ (sValue, cch) Else vValue = Empty End If Case REG_DWORD: lrc = RegQueryValueExLong (lhKey, szValueName, 0 &, lType, lValue, cch) If lrc = ERROR_NONE Then vValue = lValue Case Else lrc = -1 End selectQueryValueexexit: queryValueex = Lrc EXIT FUENCTIONQUERYVALUEEXERROR: RESUER QueryValueexexInd FunctionPublic function CreateNewKey (LPRED efinedKey As Long, _ sNewKeyName As String) Dim hNewKey As Long Dim lRetVal As Long lRetVal = RegCreateKeyEx (lPredefinedKey, sNewKeyName, 0 &, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0 &, hNewKey, lRetVal) RegCloseKey (hNewKey) End Function

Public Function SetKeyValue (lPredefinedKey As Long, _ sKeyName As String, _ sValueName As String, _ vValueSetting As Variant, _ lValueType As Long) Dim lRetVal As Long Dim hKey As Long lRetVal = RegOpenKeyEx (lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) lRetVal = SetValueEx (hKey, sValueName, lValueType, vValueSetting) RegCloseKey (hKey) End FunctionPublic Function QueryValue (lPredefinedKey As Long, _ sKeyName As String, _ sValueName As String) Dim lRetVal As Long Dim hKey As Long Dim vValue As Variant lRetVal = RegOpenKeyEx (LPREDEFINEDKEY, SKEYNAME, 0, KEY_ALL_ACCESS, HKEY) LRETVAL = QueryValueex (HKEY, SVALUENAME, VVALUE) QueryValue = VVALUE RegcloseKey (HKEY) End Function

Public SUB SetAccessMacro () 'Access2003 version adds a macro security level setting, setting DE uses here. Method: 'Operation Menu' You can customize the menu or directly call the action on the menu: 'CommLans ("Menu Bar"). Controls ("Tool (& T)"). Controls ("Macro (& M)). Controls "Safety (& S) ..."). EXECUTE 'Sets the registry (not available at runtime):' [HKEY_CURRENT_USER / SOFTWARE / Microsoft / Office / 11.0 / Access / Security] '"level" = 1 // Low' "Level" = 2 // '"level" = 3 // High' Sets the security level of Access, the macro MDB is running, whether the macro IF INSTR is displayed, "Software / Microsoft / Office / 11.0 / Access / security "," level ")," 1 ") = 0 THEN setKeyValue HKEY_CURRENT_USER," Software / Microsoft / Office / 11.0 / Access / Security "," Level "," 1 ", Reg_dword End IFEND SUB

转载请注明原文地址:https://www.9cbs.com/read-131733.html

New Post(0)