How to programmatically remove CustomUI ribbon XML customisations from MSOffice files using VBA?

Since you don't need VBA to play with a custom UI, I see no reason to automatically remove the customizations if you don't have any VBA, or it gets removed. This is a large assumption, thus, not done by Office/Microsoft.

I recommend you save in a new file, one which does not contain any custom UI. This would solve your problem immediately. The other option is to programmatically remove the customUI XML from the file, and that gets messy. As a general rule, you shouldn't be trying to do what you're trying to do, and I do not recommend it at all.

Regards,
Zack Barresse

Thanks for the input Zack. Yes, I realised about half an hour after I posted the question that the bit about VBA and customUI part are not directly linked. Still, it would be nice if Microsoft asked the question when saving from *.***m to *.***x if in addition to deleting the VBA project if the customUI part should be removed too.

I understand that the answer to my original question "how to programmatically remove the customUI" may be complex but that is the question I am seeking an answer to here, regardless of whether I should or shouldn't be approaching the problem this way. To save the content into a new file may or may not require more/less code (I know the complexity involved in transferring thousands of objects from one file to another whilst maintaining the Office theme, template etc.) but without the answer to my question, I can't decide which is easier/faster.

+1 Zack,   Impressive solution as usual

Thanks very much! :)

This is simply stunning Zack. I wasn't in the office yesterday so have only just looked at the solution and I'm reading/stepping through it to try to understand how it works. The oShellApplication.Namespace parts are intriguing as I didn't know it was possible to manipulate Zip files in VBA this way. I've not seen the use of Property Get & Let outside of a class module either so that had me thinking too. A really good solution which also serves as an educational tool far beyond the scope of the original question. Thank you so much. Now I'll spend the rest of the morning trying to adapt it for use in my target app which is PowerPoint :-)

Oh. Hang on. When I first tested it, I didn't have a customUI part in my test xlsm file. I just tried again with a customUI part and it remains in the xlsx file. Stepping through the code, I'm wondering why this line in the ZipFilesToFolder function is operating on the original xlsm copy (.xlsm.zip) rather than the Unzip folder contents where the customUI folder was deleted?

Do Until oShellApplication.Namespace(ZipFolder & Application.PathSeparator).Items.Count = FileCount

Select allOpen in new window

Finally, I know if one manually creates customUI using the zip method (as opposed to using the CUIE app), the rels XML file needs to be modified to add a reference to the customUI folder. So if we're removing the customUI using this zip method, does the rel reference need to be removed from the _rels folder too? In my test file, I see 4 relationships, the first one being this:

<Relationship Id="R139f8dc3b647481d" Type="http://schemas.microsoft.com/office/2007/relationships/ui/extensibility" Target="customUI/customUI14.xml"/>

Select allOpen in new window

I interrupted your code at the end of RemoveCustomUI sub and then zipped the contents manually to another xlsm file and Excel didn't complain when opening it but I'm wondering if this could cause an issue later.

I've ported your code for PowerPoint use Zack and added the ZIP file archive creation with the help of Ron de Bruin. I've not done the _rels mod as yet but probably will at some point just to make sure it doesn't create any issues later.

Option Explicit

Public Const PathSeparator = "\"

' Creates a copy of the active presentation and then strips the customUI XML from it
' Process Outline:
' 1. Create a copy of the .pptm file in .pptx format (removing VBA in the process)
' 2. Rename the file from .pptx to .zip
' 3. Create a temporary unzip folder
' 4. Unzip the file
' 5. Delete the customUI folder
' 6. Rezip the folder
' 7. Rename the zip file to .pptx
' 8. Delete the temporary unzip folder
' 9. Delete the .pptx file
Sub StripVBAandCustomUI()
  Dim PPTFileName As Variant
  Dim ZipFileName As Variant
  Dim MainPath As Variant
  Dim PathCustomUI As String
  Dim UnzipFolderPath As Variant
  Dim FSO As Object
  
  With ActivePresentation
    MainPath = .Path & PathSeparator
    PPTFileName = Replace(.Name, ".pptm", ".pptx")
    
    ' Create a copy of the active presentation in .pptx format
    .SaveCopyAs MainPath & PPTFileName, ppSaveAsOpenXMLPresentation
  End With
  
  ' Rename the .pptx file to .zip
  ZipFileName = Replace(PPTFileName, ".pptx", ".zip")
  Name MainPath & PPTFileName As MainPath & ZipFileName
  
  ' Create the temporarary unzip folder
  UnzipFolderPath = MainPath & "Unzip" & PathSeparator
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If FSO.FolderExists(UnzipFolderPath) Then
    FSO.DeleteFolder UnzipFolderPath & "*", True
  End If
  MkDir UnzipFolderPath
  
  ' Unzip the archive
  UnZip MainPath & ZipFileName, UnzipFolderPath
  
  ' Delete the archive (copy of the active presentation without VBA)
  Kill MainPath & ZipFileName
  
  ' Delete the customUI folder and contents
  PathCustomUI = UnzipFolderPath & PathSeparator & "customUI"
  If FolderExists(PathCustomUI) Then FSO.DeleteFolder PathCustomUI
  
  ' Rezip the files in the temporary unzip folder
  ZipAllFilesInFolder UnzipFolderPath, MainPath & ZipFileName
  
  ' Rename the .zip file to .pptx
  Name MainPath & ZipFileName As MainPath & PPTFileName
  
  ' Clean up
  FSO.DeleteFolder Left(UnzipFolderPath, Len(UnzipFolderPath) - 1)
  Set FSO = Nothing
End Sub

' Return True if the file or folder exists, False otherwise. This routine does not use the Dir
' technique as the Dir function resets any current Dir process.
' FilePath - Full path to the folder or file to be evaluated.
Public Function FileExists(ByVal FilePath As String) As Boolean
  Dim Attributes As Integer

  On Error Resume Next
  Attributes = GetAttr(FilePath)
  FileExists = (Err.Number = 0) And (Attributes And vbDirectory) = 0
  Err.Clear
End Function

' Return True if the path is a folder, False otherwise. This routine does not use the Dir technique
' as the Dir function resets any current Dir process.
' FolderPath - Full path to the folder to be evaluated.
Public Function FolderExists(ByVal FolderPath As String) As Boolean
  Dim Attributes As Integer

  On Error Resume Next
  Attributes = GetAttr(FolderPath)
  FolderExists = (Err.Number = 0) And (Attributes And vbDirectory) <> 0
  Err.Clear
End Function

' Original Excel-based source : http://www.rondebruin.nl/win/s7/win001.htm

' Ron de Bruin
' Strings declared as Variant due to shell object bug
Sub ZipAllFilesInFolder(PathToFiles As Variant, ZipFileName As Variant)
    Dim oApp As Object

    ' Create a new empty Zip File
    NewZip (ZipFileName)

    Set oApp = CreateObject("Shell.Application")
    ' Copy the files to the compressed folder
    oApp.Namespace(ZipFileName).CopyHere oApp.Namespace(PathToFiles).Items

    ' Wait until compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(ZipFileName).Items.Count = oApp.Namespace(PathToFiles).Items.Count
      Delay 1, True
    Loop
    On Error GoTo 0
End Sub

' Create an empty Zip File
' Changed by keepITcool Dec-12-2005
Sub NewZip(sPath)
  If Len(Dir(sPath)) > 0 Then Kill sPath
  Open sPath For Output As #1
  ' Zip file header signature (see https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT)
  ' Hex 50,4B,05,06, 18 x 00
  Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
  Close #1
End Sub

' Original Excel-based source : http://www.rondebruin.nl/win/s7/win002.htm
Sub UnZip(ZipFileName As Variant, OutputFolderPath As Variant)
  Dim oShellApp As Object
  
  ' Extract the files into the specified folder
  Set oShellApp = CreateObject("Shell.Application")
  oShellApp.Namespace(OutputFolderPath).CopyHere oShellApp.Namespace(ZipFileName).Items
  Set oShellApp = Nothing
End Sub

Public Sub Delay(Seconds As Single, Optional DoAppEvents As Boolean)
  Dim TimeNow As Long
  TimeNow = Timer
  Do While Timer < TimeNow + Seconds
    If DoAppEvents = True Then DoEvents
  Loop
End Sub

Select allOpen in new window

Thanks for the kind words Jamie. :) Let me address your questions separately.

Property Get/Let
These are typically used in a class module, because a class is a custom object. Thus it need properties and methods: subs, functions, properties. Those become properties of the class. Generally speaking you can use a property anywhere, in any module. I use them constantly in worksheet modules, creating custom range properties pointing to parts of the sheet, like tables and named ranges. This makes it super easy to access those items via code anywhere in the project. In fact, my business partner (Kevin Jones, aka zorvek) and I are creating some developer tools which make this really easy to do (mapped to a keyboard shortcut).

oShellApplication.Namespace
The Namespace method is really handy when working with zip files. It's not well known because 1) it's external to vanilla Excel, and 2) there's not much documentation on it. Both Ron de Bruin and Jan Karel Pieterse have great resources on their sites in working with Excel files and zipped contents.
http://rondebruin.nl/win/section7.htm
http://jkp-ads.com/Articles/Excel2007FileFormat02.asp
You can use this methodology in most Office applications (I can't confirm for all, because I've never tried it, although theoretically it should work in all).

_rels folder
I don't believe this has any impact on removing the customUI. The relationship defined has to point to the schema, which resides online. Currently there's only two schemas to choose from: that for an Office 2007 file, and that for an Office 2010 file. The only discernible difference in the schema URL's is the date. This is what basically validates the XML for the UI, and gives us access to the attributes, properties, etc. Unfortunately it's far from perfect. There hasn't been an updated schema from Microsoft since 2010. Why? I have no idea. What I do know is that they know about it. Hopefully we'll see some improvements with it. Ron de Bruin does a lot of work in this space and has probably the best site for customUI information - both PC and Mac. That being said, I don't think you need to remove the _rels folder. As far as I know it has no impact on removing the customUI folder, as keeping it is only a pointer.

Do Until ...
This is more or less a trick to get the application to wait for the Shell/Zip process to complete. Since VBA is a First-In-First-Out (FIFO), Object Oriented Programming (OOP) language, making the external call to the Shell object could wind up in a process out of sync. Another example would be if we made a web call, and needed to wait for the return before continuing. Here we want to wait for all items to be zipped and that process to be done before continuing. This adds that time buffer to ensure it's done being zipped before we continue. It's probably less of a concern with modern computers, but slow machines could get ahead of themselves.

I haven't tested your PPT code. Does it work for you? I'm not sure why you couldn't get the Excel version to work. It worked well for me in testing. Let me know what else I can do for you.

Kind regards,
Zack

Great follow up comments Zack. Regarding the last point, yes my adapted version works in PowerPoint but I used a different method to create the new Zip file by first creating an empty Zip file (Sub NewZip) with the correct binary header and then using the Shell Namespace CopyHere method to copy the files from the unzipped and modified version of the XML archive. I don't see how your ZipFilesToFolder function can work because it is operating on the unmodified .xlsm.zip archive and not the unzipped contents of the folder you created called Unzip Folder. My point about the Do Until part is that the following code doesn't appear to do anything other than return the number of items in the folder and compare it to the value:

    FileCount = oShellApplication.Namespace(ZipFolder & Application.PathSeparator).Items.Count
    On Error Resume Next
    Do Until oShellApplication.Namespace(ZipFolder & Application.PathSeparator).Items.Count = FileCount
        Application.Wait Now + TimeValue("0:00:01")
    Loop
    DoEvents
    On Error GoTo 0

Select allOpen in new window

Once this part is done, you then rename the original .xlsm.zip archive back to a .xlsm file but it still contains the customUI folder as this archive was never modified before deleting the modified unzipped version. The modified version in the Unzip Folder is never re-zipped. Are my observations clearer?

Finally, having done some follow up reading on the Shell Folder OM, properties and methods, it looks like it's possible to avoid having to unzip the archive at all because one could use the MoveTo method to move the customUI folder out of the Zip file and then delete it from the file system. This technique offers a substantial efficiency improvement for larger Office files as the decompression and recompression steps are avoided. Modified single procedure solution:

Option Explicit

' To use IntelliSense when coding, change this to True and add references to:
' 1. Microsoft Shell Controls and Automation
' 2. Microsoft Scripting Runtime
' When finished coding, change back to False and remove the reference
#Const EarlyBinding = False

' ==========================================================================
' Removes the customUI folder from the specified Office file.
' Note : the _rels customUI reference is not removed as it's just a pointer.
' Simplified design for PC versions of Office only (adapt paths for Mac use)
' Inputs : FilePathAndName - the full path and file name of the source
'          Office file. Can be any XML-based file for PowerPoint, Excel or
'          Word e.g. .potx,.potm, .xlsx,.xlsm, .docx,.docm
' Author : Jamie Garroch of YOUpresent.co.uk
' ==========================================================================
Sub RemoveCustomUI(FilePathAndName As String)
  Dim oApp As Object
#If EarlyBinding Then
  Dim oShell As Shell
  Dim oFSO As FileSystemObject
  Dim SourcePath As FolderItem
#Else
  Dim oShell As Object
  Dim oFSO As Object
  Dim SourcePath As Variant
#End If
  
  Set oApp = Application
  Select Case True
    Case UCase(oApp.Name) Like "*POWERPOINT*": SourcePath = oApp.ActivePresentation.Path
    Case UCase(oApp.Name) Like "*EXCEL*": SourcePath = oApp.ThisWorkbook.Path
    Case UCase(oApp.Name) Like "*WORD*": SourcePath = oApp.ActiveDocument.Path
    Case Else
      MsgBox "Please modify code to support other Office apps.", vbCritical + vbOKOnly, "Office App Not Supported"
      Exit Sub
  End Select
  
  If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
  
  ' Rename the Office file as a Zip file, maintaining the source name by simply appending ".zip"
  Name FilePathAndName As FilePathAndName & ".zip"
  Set oShell = CreateObject("Shell.Application")
  
  ' Move the customUI folder out of the Zip archive (without fully decompressing the archive)
  ' Doesn't raise an error if no customUI folder found
  oShell.NameSpace(SourcePath).MoveHere (FilePathAndName & ".zip\customUI")
  
  ' Delete the decompressed customUI folder from the [uncompressed] file system
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next ' In case no customUI was present
  oFSO.DeleteFolder SourcePath & "customUI"
  On Error GoTo 0
  
  ' Rename the Zip file back to the source file name
  Name FilePathAndName & ".zip" As FilePathAndName
  
  ' Clean up
  Set oApp = Nothing
  Set oShell = Nothing
  Set oFSO = Nothing
  
End Sub

Select allOpen in new window

Thanks for the pointer to the Shell Folder code Zack. Couldn't have done it without you! Going to write an article on this now :-)

Finally, I would prefer not to ever use this technique and rather build the client solution as an add-in but they specifically asked for it to be built into a single macro-enabled file, hence being forced down this path.