Visual Basic Programming Code Examples

Visual Basic > Other Code Examples

Enable and disable Excel's macro virus protection

Enable and disable Excel's macro virus protection

The following code demostrates how to turn on/off macro virus protection for Office 2003/XP/2000 and Excel 97.

Option Compare Text
Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lhKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal lhKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lhKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Const REG_HEX As Long = 4       'Hex Key
Private Const HKEY_CURRENT_USER As Long = &H80000001

Public Enum eApplication
    eExcel
    eOutlook
    eWord
    ePowerPoint
    ePublisher
End Enum

Public Enum eVersion
    eOffice2003
    eOffice2000
    eOfficeXP
End Enum



'Purpose     :  Enables or disables the macro virus alert.
'Inputs      :  bDisableVirusChecking       True, disables macro security protection
'                                           False, enables macro security protection
'Outputs     :  Returns True on success


Function Excel97MacroSecurity(bDisableVirusChecking As Boolean) As Boolean
    Dim lData As Long, lRet As Long
    Const csPath = "Software\Microsoft\Office\8.0\Excel\Microsoft Excel", csValue = "Options6"
    
    On Error GoTo ErrFailed
    If bDisableVirusChecking Then
        lData = 0             'Disabled
    Else
        lData = 8             'Enabled
    End If
    RegCreateKey HKEY_CURRENT_USER, csPath, lRet
    RegSetValueEx lRet, csValue, 0, REG_HEX, lData, 4
    RegCloseKey lRet
    Excel97MacroSecurity = True
    
    Exit Function

ErrFailed:
    Debug.Print Err.Description
    Excel97MacroSecurity = False
End Function



'Purpose     :  Enables or disables the macro virus alert by altering the security level in the registry.
'Inputs      :  lSecurityLevel              1, sets security to "Low" (disable virus alerts)
'                                           2, sets security to "Medium"
'                                           3, sets security to "High"
'                                           4, sets security to "High" and disables access to VB Object Model
'               AppType                     The application to set the security for.
'               OfficeVersion               The installed version of Office.
'Outputs     :  Returns True on success
'Notes       :  Requires Excel 2000


Function OfficeMacroSecurity(lSecurityLevel As Long, AppType As eApplication, OfficeVersion As eVersion) As Boolean
    Dim sData As String, lRet As Long, sAppKey As String
    Const csKeyGen As String = "Software\Microsoft\Office\[VERSION]\[APPLICATION]\Security"
    Const csKeyVBOM As String = "AccessVBOM", csKey  As String = "Level"
    
    If lSecurityLevel <= 4 And lSecurityLevel > 0 Then
        On Error GoTo ErrFailed
        Select Case OfficeVersion
        Case eOffice2000
            sAppKey = Replace$(csKeyGen, "[VERSION]", "9.0")
        Case eOfficeXP
            sAppKey = Replace$(csKeyGen, "[VERSION]", "10.0")
        Case eOffice2003
            sAppKey = Replace$(csKeyGen, "[VERSION]", "11.0")
        Case Else
            Debug.Print "Invalid version"
            Debug.Assert False
            OfficeMacroSecurity = False
            Exit Function
        End Select
        
        Select Case AppType
        Case eExcel
            sAppKey = Replace$(sAppKey, "[APPLICATION]", "Excel")
        Case eOutlook
            sAppKey = Replace$(sAppKey, "[APPLICATION]", "Outlook")
        Case ePowerPoint
            sAppKey = Replace$(sAppKey, "[APPLICATION]", "PowerPoint")
        Case ePublisher
            sAppKey = Replace$(sAppKey, "[APPLICATION]", "Publisher")
        Case eWord
            sAppKey = Replace$(sAppKey, "[APPLICATION]", "Word")
        Case Else
            Debug.Print "Invalid application"
            Debug.Assert False
            OfficeMacroSecurity = False
            Exit Function
        End Select
        
        RegCreateKey HKEY_CURRENT_USER, sAppKey, lRet
        'Set the registry key macro security reg key
        If lSecurityLevel = 4 Then
            'Set to high
            RegSetValueEx lRet, csKey, 0, REG_HEX, 3, 4
        Else
            'Set to the specified level
            RegSetValueEx lRet, csKey, 0, REG_HEX, lSecurityLevel, 4
        End If
                
        If lSecurityLevel < 4 Then
            'Enable access to VB Object Model
            RegSetValueEx lRet, csKeyVBOM, 0, REG_HEX, 1, 4
        Else
            'Disable access to VB Object Model
            RegSetValueEx lRet, csKeyVBOM, 0, REG_HEX, 0, 4
        End If
        
        RegCloseKey lRet
        
        OfficeMacroSecurity = True
    Else
        Debug.Print "Invalid Security Level"
        Debug.Assert False
    End If
    
    Exit Function
    
ErrFailed:
    Debug.Print Err.Description
    OfficeMacroSecurity = False
End Function