Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macros Disabled

Status
Not open for further replies.

tamer64

IS-IT--Management
Aug 27, 2007
120
US
I am hoping this is the right forum for this question. We will be migrating to windows 7 with Office 2010 from Windows XP Office 2007 in the next few months. We have imaged one of our test machines and have found out that our MS Office products have had some restrictions placed on them through a GPO which was included in the base image. The GPO has restricted us from enabling all Macros. Most of all our databases which were created in MS Access 2007 have macros enabled, when I attempt to open one of the databases in MS Access 2010 I get a white screen and I presume this is because the macro feature is disabled.

Is there anyway to bypass this GPO through VBA or through some other process which would allow us to run these databases with Macros enabled in MS Access 2010?
 


This is how I got around it. Not sure if it will work for you, but it is worth a try.

I stuff the registry with the settings I needed.

Code:
Option Explicit

Const OverwriteExisting = True

Dim WshNetwork
Dim strUser 
Set WshNetwork = WScript.CreateObject("WScript.Network")
strUser = WshNetwork.UserName

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")

    'WScript.Echo GetOSArchitecture()

    Dim strAccessVBOM
    Dim strVBAWarnings
    Dim strUFIControls
    Dim strArchitecture

    strArchitecture = GetOSArchitecture()

    Dim Application_Version
    Application_Version = "14.0"

    strAccessVBOM = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application_Version & "\Access\Security\AccessVBOM"
    strVBAWarnings = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application_Version & "\Access\Security\VBAWarnings"
    strUFIControls= "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\Security\UFIControls"

'    WScript.echo strAccessVBOM
'    WScript.echo strVBAWarnings
'    WScript.echo strUFIControls

    WshShell.RegWrite strAccessVBOM, 1, "REG_DWORD"
    WshShell.RegWrite strVBAWarnings, 1, "REG_DWORD"
    WshShell.RegWrite strUFIControls, 1, "REG_DWORD"


'	arrValues = objShell.RegRead _
'	 ("HKLM\SOFTWARE\ODBC\ODBCINST.INI")
'	For Each strValue In arrValues
'	  If strValue = "SQL Server Native Client 10.0" Then
'          'Skip Install
'          Else
'            Run "sqlncli" &  ".msi" & "/passive /norestart"
'	Next




Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "myAccessApp.accdb" , _
		"myAccessApp.accdb" & strUser &  ".accdb", OverwriteExisting

Run "myAccessApp.accdb" & strUser &  ".accdb"

objfso.DeleteFile "myAccessApp.accdb" & strUser &  ".accdb"

WScript.Quit 1








'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------

Sub Run(ByVal sFile)
Dim shell

    Set shell = CreateObject("WScript.Shell")
    shell.Run Chr(34) & sFile & Chr(34) & "/nostartup", 1, True

Set shell = Nothing

End Sub

'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------

Function GetOSArchitecture()
Dim objWMIservice
Dim colItems
Dim objItem
Dim strWQL
Dim strArchitecture 
Dim strComputer 

    strWQL = "SELECT * FROM Win32_OperatingSystem"
    strComputer = "."
    
    Set objWMIservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIservice.ExecQuery(strWQL, , 48)

    For Each objItem In colItems
        If Left(objItem.Version,1) > 5 Then
            strArchitecture = objItem.OSArchitecture
        Else
            strArchitecture = Null
        End If
    Next
    
    GetOSArchitecture = strArchitecture

Set objItem = Nothing
Set colItems = Nothing
Set objWMIservice = Nothing

End Function

'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------

Function GetOSVersion()

    Dim objWMIservice
    Dim colItems
    Dim objItem
    Dim strWQL
    Dim strVersion 

    strWQL = "SELECT * FROM Win32_OperatingSystem"
    strComputer = "."
    
    Set objWMIservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIservice.ExecQuery(strWQL, , 48)

    For Each objItem In colItems
        strVersion = objItem.Version
    Next
    
    GetOSVersion = strVersion

    Set objItem = Nothing
    Set colItems = Nothing
    Set objWMIservice = Nothing

End Function


Thanks

John Fuhrman
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top