Sunday, 25 January 2015

Trusted Locations: a source of misleading error messages


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