Unblock Files Blocked by Office2003 SP3

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Unblock Files Blocked by Office2003 SP3

Logged in as: Guest

arrSession:exec spGetSession 2,16,62735

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Unblock Files Blocked by Office2003 SP3
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Unblock Files Blocked by Office2003 SP3 - 7/24/2008 10:55:19 AM

TomRiddle

Posts: 170
Score: 4
Joined: 2/7/2008
Status: offline

Unblock Files Blocked by Office2003 SP3

I have another script that reverses this, ie reblock the files. Check out this link for more information http://support.microsoft.com/kb/938810/en-us

'Script by TomRiddle 2008
'Unblock file types blocked by Office2003 SP3.
'http://support.microsoft.com/kb/938810/en-us

'-----------------------------------------------------------------------
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const HKEY_CURRENT_USER = &H80000001
  Const HKEY_USERS  = &H80000003 
  strComputer = inputbox("Enter name of REMOTE PC to check the "&vbcrlf&"current user's office Blocking Status "&vbcrlf&vbcrlf&"Press cancel to check THIS computer's"&vbcrlf&"Office2003 Blocking Status", "UNBLOCK") 
  if strComputer<>"" then
    'ACT ON REMOTE MACHINE ***********************************************
     CU=GetCurrentUser(strComputer)
     CUSID = GetSIDFromUser(CU)
     Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
        strComputer & "\root\default:StdRegProv")
     on error resume next
    'Read Corel
     strKeyPath = "Software\Microsoft\Shared Tools\Graphics Filters\Import\CDR"
     strValueName = "Enabled"
     oReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
     result = dwValue
    'Read Powerpoint
     strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\PowerPoint\Security\FileOpenBlock"
     strValueName = "FilesBeforePowerPoint97"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\PowerPoint\Security\FileSaveBlock"
     strValueName = "FilesBeforePowerPoint97"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue
    'Read Excel
     strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Excel\Security\FileOpenBlock"
     strValueName = "LotusandQuattroFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyBinaryFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyDatabaseAndDatasourceFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Excel\Security\FileSaveBlock"
     strValueName = "LotusandQuattroFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyBinaryFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyDatabaseAndDatasourceFiles"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
    'Read Word
     strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Word\Security\FileOpenBlock"
     strValueName = "FilesBeforeVersion"
     oReg.GetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     on error goto 0
     if result = "1000000000" then 
        msgbox "Already Set to Unblock"
     else
        on error resume next
       'Write Corel
        strKeyPath = "Software\Microsoft\Shared Tools\Graphics Filters\Import\CDR"
        strValueName = "Enabled"
        dwValue = 00000001
        oReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
        oReg.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
       'Write Powerpoint
        strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\PowerPoint\Security\FileOpenBlock"
        strValueName = "FilesBeforePowerPoint97"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\PowerPoint\Security\FileSaveBlock"
        strValueName = "FilesBeforePowerPoint97"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
       'Write Excel
        strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Excel\Security\FileOpenBlock"
        strValueName = "LotusandQuattroFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strValueName = "LegacyBinaryFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strValueName = "LegacyDatabaseAndDatasourceFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Excel\Security\FileSaveBlock"
        strValueName = "LotusandQuattroFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strValueName = "LegacyBinaryFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        strValueName = "LegacyDatabaseAndDatasourceFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
       'Write Word
        strKeyPath = CUSID&"\Software\Microsoft\Office\11.0\Word\Security\FileOpenBlock"
        strValueName = "FilesBeforeVersion"
        dwValue = 00000000
        oReg.CreateKey HKEY_USERS,strKeyPath
        oReg.SetDWORDValue HKEY_USERS,strKeyPath,strValueName,dwValue
        if err <> 0 then 
           msgbox "Script failed to write"
        else
           msgbox "Script wrote registry keys successfully"
        end if
        wscript.quit
     end if
 else
    'ACT ON LOCAL MACHINE ***************************************************
     strComputer = "."

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
     strComputer & "\root\default:StdRegProv")
     on error resume next
    'Read Corel
     strKeyPath = "Software\Microsoft\Shared Tools\Graphics Filters\Import\CDR"
     strValueName = "Enabled"
     oReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
     result = dwValue 
    'Read Powerpoint
     strKeyPath = "Software\Microsoft\Office\11.0\PowerPoint\Security\FileOpenBlock"
     strValueName = "FilesBeforePowerPoint97"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strKeyPath = "Software\Microsoft\Office\11.0\PowerPoint\Security\FileSaveBlock"
     strValueName = "FilesBeforePowerPoint97"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue
    'Read Excel
     strKeyPath = "Software\Microsoft\Office\11.0\Excel\Security\FileOpenBlock"
     strValueName = "LotusandQuattroFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyBinaryFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyDatabaseAndDatasourceFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strKeyPath = "Software\Microsoft\Office\11.0\Excel\Security\FileSaveBlock"
     strValueName = "LotusandQuattroFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyBinaryFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     strValueName = "LegacyDatabaseAndDatasourceFiles"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
    'Read Word
     strKeyPath = "Software\Microsoft\Office\11.0\Word\Security\FileOpenBlock"
     strValueName = "FilesBeforeVersion"
     oReg.GetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
     result = result & dwValue 
     on error goto 0
     if result = "1000000000" then 
        msgbox "Already Set to Unblock"
     else
        on error resume next
       'Write Corel
        strKeyPath = "Software\Microsoft\Shared Tools\Graphics Filters\Import\CDR"
        strValueName = "Enabled"
        dwValue = 00000001
        oReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
        oReg.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
       'Write Powerpoint
        strKeyPath = "Software\Microsoft\Office\11.0\PowerPoint\Security\FileOpenBlock"
        strValueName = "FilesBeforePowerPoint97"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strKeyPath = "Software\Microsoft\Office\11.0\PowerPoint\Security\FileSaveBlock"
        strValueName = "FilesBeforePowerPoint97"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
       'Write Excel
        strKeyPath = "Software\Microsoft\Office\11.0\Excel\Security\FileOpenBlock"
        strValueName = "LotusandQuattroFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strValueName = "LegacyBinaryFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strValueName = "LegacyDatabaseAndDatasourceFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strKeyPath = "Software\Microsoft\Office\11.0\Excel\Security\FileSaveBlock"
        strValueName = "LotusandQuattroFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strValueName = "LegacyBinaryFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        strValueName = "LegacyDatabaseAndDatasourceFiles"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
       'Write Word
        strKeyPath = "Software\Microsoft\Office\11.0\Word\Security\FileOpenBlock"
        strValueName = "FilesBeforeVersion"
        dwValue = 00000000
        oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
        oReg.SetDWORDValue HKEY_CURRENT_USER,strKeyPath,strValueName,dwValue
        if err <> 0 then 
           msgbox "Script failed to write"
        else
           msgbox "Script wrote registry keys successfully"
        end if
     end if
     wscript.quit
  end if
'-----------------------------------------------------------------------
Function GetCurrentUser(strComputer) 
'Input: strComputer = machine to query 
'Output: Current User as domain\logon 
'Only works on XP/W2003
  on error resume next
  Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
  Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'explorer.exe'") 
  For Each objProcess in colProcessList 
     objProcess.GetOwner strUserName, strUserDomain 
  Next 
  GetCurrentUser = strUserDomain & "\" & strUserName 
  if err<> 0 then
     Msgbox " Error accessing remote machine"
     wscript.quit
  end if
  on error goto 0
End Function 
'-----------------------------------------------------------------------
Function GetSIDFromUser(UserName) 
'Input: UserName as domain\logon 
'Output: SID 
'http://groups.google.com/group/microsoft.public.scripting.vbscript/msg/1bd0d208ef41dda7
  Dim DomainName, Result, WMIUser 
  If InStr(UserName, "\") > 0 Then 
     DomainName = Mid(UserName, 1, InStr(UserName, "\") - 1) 
     UserName = Mid(UserName, InStr(UserName, "\") + 1) 
  Else 
     DomainName = CreateObject("WScript.Network").UserDomain 
  End If 
  On Error Resume Next 
  Set WMIUser = GetObject("winmgmts:{impersonationlevel=impersonate}!" _ 
     & "/root/cimv2:Win32_UserAccount.Domain='" & DomainName & "'" _ 
        & ",Name='" & UserName & "'") 
  If Err = 0 Then Result = WMIUser.SID Else Result = ""
  On Error GoTo 0 
  GetSIDFromUser = Result 
End Function 
'-----------------------------------------------------------------------