When's the last time you ran some VBA that opened a spreadsheet over the network? Or even on your own local temp folder?
If you're working in Office 2010 or 2013, you might just have seen this error message:
Office has detected a problem with this file. To help protect your computer this file cannot be opened.
...But you open the file yourself, manually, and it's fine. Readable, no error messages on open, maybe contains VBA macros and COM controls and you get a warning message, but not corrupted or obviously malicious.
You *might* see a message about content disabled, or the 'Trust Centre'.
What's actually happened is that the 'Trust Centre' ('Trust Center' in American English) needs a manual intervention to add the folder containing your file, and to label it as a safe location.
Microsoft have published instructions on doing this here:
Support.Office.com: Add, remove, or change a trusted location
That's great if it's just you, but unhelpful if you write applications that open Excel files. But, before I show you the VBA to automate away that annoyance, here's a short code snippet for opening Excel files safely in a separate 'sanitised' instance of Excel.exe:
Application.ShowStartupDialog = False
With New Excel.Application
On Error Resume Next
.ShowStartupDialog = False
.Visible = False
.EnableCancelKey = xlDisabled
.UserControl = False
.Interactive = False
.EnableEvents = False
'If .Calculation <> xlCalculationManual Then
' .Calculation = xlCalculationManual
'End If
'.CalculateBeforeSave = False
.DisplayAlerts = False
.AutomationSecurity = msoAutomationSecurityForceDisable
On Error Resume Next
For i = 1 To .AddIns.Count
If .AddIns(i).IsOpen Then
.AddIns(i).Installed = False
End If
Next i
For i = 1 To .COMAddIns.Count
.COMAddIns(i).Connect = False
If Not .COMAddIns(i).Object Is Nothing Then
.COMAddIns(i).Object.Close
.COMAddIns(i).Object.Quit
End If
Next i
On Error GoTo ErrAppExit
.Workbooks.Open FileName = strFile, _
UpdateLinks:=False, _
ReadOnly:=True, _
Password:=vbNullString, _
Notify:=False, _
AddToMRU:=False
' **** Your code to work on the file goes here ****
' **** Set all objects to Nothing before exiting ****
For i = .Workbooks.Count To 1 Step -1
.Workbooks(i).Close
Next i
ErrAppExit:
On Error Resume Next
If Err.Number > 0 Then
StatusMessage = "#ERROR " & Err.Number & ": " & Err.Description & sError
End If
.Quit
End With 'New Excel.Application
The Trust Centre is annoying, but you might want to take *some* precautions when opening files from a bad neighborhood. Especially if others will use your VBA code to open files from places you never heard of.
Whatever. Here's the code to set a trusted location which I posted in StackOverflow a couple of days ago:
TrustThisFolder(): Excel VBA Code to Add a Folder to the 'Trusted Folders' Registry List.
Private Sub TrustThisFolder(Optional FolderPath As String, _
Optional TrustSubfolders As Boolean = True, _
Optional TrustNetworkFolders As Boolean = False, _
Optional sDescription As String)
' Add a folder to the 'Trusted Locations' list so that your project's VBA can
' open Excel files without raising errors like "Office has detected a problem
' with this file. To help protect your computer this file cannot be opened."
' Ths function has been implemented to fail silently on error: if you suspect
' that users don't have permission to assign 'Trusted Location' status in all
' locations, reformulate this as a function returning True or False
' Nigel Heffernan January 2015 http:\\Excellerando.blogspot.com
'
' Based on code published by Daniel Pineault in DevHut.net on June 23, 2010:
' www.devhut.net\2010\06\23\vbscript-createset-trusted-location-using-vbscript\
' **** **** **** **** THIS CODE IS IN THE PUBLIC DOMAIN **** **** **** ****
' UNIT TESTING:
'
' 1: Reinstate the commented-out line 'Debug.Print sSubKey & vbTab & sPath
' 2: Open the Immediate Window and run this command:
' TrustThisFolder "Z:\", True, True, "The user's home directory"
' 3: If "Z:\" is already in the list, choose another folder
' 4: Repeat step 2 or 3: the folder should be listed in the debug output
' 5: If it isn't listed, disable the error-handler and record any errors
'
On Error GoTo ErrSub
Dim sKeyPath As String
Dim oRegistry As Object
Dim sSubKey As String
Dim oSubKeys ' type not specified. After it's populated, it can be iterated
Dim oSubKey ' type not specified.
Dim bSubFolders As Boolean
Dim bNetworkLocation As Boolean
Dim iTrustNetwork As Long
Dim sPath As String
Dim sDate As String
Dim sDesc As String
Dim i As Long
Const HKEY_CURRENT_USER = &H80000001
bSubFolders = True
bNetworkLocation = False
If FolderPath = "" Then
FolderPath = FSO.GetSpecialFolder(2).Path
If sDescription = "" Then
sDescription = "The user's local temp folder"
End If
End If
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
sKeyPath = ""
sKeyPath = sKeyPath & "SOFTWARE\Microsoft\Office\"
sKeyPath = sKeyPath & Application.Version
sKeyPath = sKeyPath & "\Excel\Security\Trusted Locations\"
Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
' Note: not the usual \root\cimv2 for WMI scripting: the StdRegProv isn't in that folder
oRegistry.EnumKey HKEY_CURRENT_USER, sKeyPath, oSubKeys
For Each oSubKey In oSubKeys
sSubKey = CStr(oSubKey)
oRegistry.GetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Path", sPath
'Debug.Print sSubKey & vbTab & sPath
If sPath = FolderPath Then
Exit For
End If
Next oSubKey
If sPath <> FolderPath Then
If IsNumeric(Replace(sSubKey, "Location", "")) Then
i = CLng(Replace(sSubKey, "Location", "")) + 1
Else
i = UBound(oSubKeys) + 1
End If
sSubKey = "Location" & CStr(i)
If TrustNetworkFolders Then
iTrustNetwork = 1
oRegistry.GetDWORDValue HKEY_CURRENT_USER, sKeyPath, "AllowNetworkLocations", iTrustNetwork
If iTrustNetwork = 0 Then
oRegistry.SetDWORDValue HKEY_CURRENT_USER, sKeyPath, "AllowNetworkLocations", 1
End If
End If
oRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey
oRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Path", FolderPath
oRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "Description", sDescription
oRegistry.SetDWORDValue HKEY_CURRENT_USER, sKeyPath & "\" & sSubKey, "AllowSubFolders", 1
End If
ExitSub:
Set oRegistry = Nothing
Exit Sub
ErrSub:
Resume ExitSub
End Sub
You will note that I acknowledge the original author, Daniel Pineault, who posted this code on DevHut.net in 2010: VB Script to set a Trusted Location
This code has been widely-reposted without attribution: please don't do that, it's discourteous - if you, too, aspire to being recognised as an 'expert', this can only happen if you're working in a culture that acknowledges expertise; and you, and your courtesy to others, *are* that culture.
No comments:
Post a Comment