open the styles.xml and edit it to have no styles

For whatever reason running the normal VBA that would delete styles is taking a long time to run (to delete my over 50,000 styles) and is failing to do anything anyway.
I would like to instead be able to use VBA code to do the below

Which basically opens up the styles.xml that is zipped in the excel file and blow away the styles.

this is better than doing it manually as
A) I want users to be able to fix it themselves
B) This is pretty hard to do in notepad anyway, and i can't have decent text exiting software.

1. Rename your Excel workbook from .xlsx or .xlsm to .zip
2. Open the workbook with WinZip and navigate to xl folder
3. Right click on styles.xml and choose Open With Notepad
4. Hit Ctrl F to search for "cellstyles"
5. Replace everything between "< cellstyles" and "< /cellstyles" with the following XML code:
  < cellStyles count="1" >
    < cellStyle name="Normal" xfId="0" builtinId="0" customBuiltin="1" / >
  < /cellStyles >
6. Save the Notepad and exit Notepad. WinZip should now ask you whether to update the file. Select Update Zip file with changes. Hit OK and close out WinZip.
7. Rename the workbook zip file back to .xlsx or .xlsm

NB: I had to edit the xml to let it upload so i edited in spaces next to the < and > in the xml code

So step 1 is ok

Function rename_to_zip(file_to_rename)
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
ZIPFilePath = FSO.GetParentFolderName(file_to_rename) & "\" & FSO.GetBaseName(file_to_rename) & ".zip"
  If FSO.FileExists(ZIPFilePath) Then FSO.DeleteFile ZIPFilePath, True
    FSO.MoveFile file_to_rename, ZIPFilePath

Set FSO = Nothing
rename_to_zip = ZIPFilePath
End Function

and if i use that then my path to the styles folder would be -

FSO.GetParentFolderName(file_to_rename) & "\" & FSO.GetBaseName(file_to_rename) & ".zip"&"\xl\styles.xml"

but what next?

OK
i think i have the basic steps here done reasonably efficiently

Function rename_to_xlsm(file_to_rename)
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
ZIPFilePath = FSO.GetParentFolderName(file_to_rename) & FSO.GetBaseName(file_to_rename) & ".xlsm"
  If FSO.FileExists(ZIPFilePath) Then FSO.deletefile ZIPFilePath, True
    FSO.MoveFile file_to_rename, ZIPFilePath
Set FSO = Nothing
rename_to_xlsm = ZIPFilePath
End Function

Function rename_to_zip(file_to_rename)
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
ZIPFilePath = FSO.GetParentFolderName(file_to_rename) & FSO.GetBaseName(file_to_rename) & ".zip"
  If FSO.FileExists(ZIPFilePath) Then FSO.deletefile ZIPFilePath, True
    FSO.MoveFile file_to_rename, ZIPFilePath

Set FSO = Nothing
rename_to_zip = ZIPFilePath
End Function


Function myFileExists(ByVal strPath As String) As Boolean
    'Function returns true if file exists, false otherwise
    If Dir(strPath) > "" Then
        myFileExists = True
    Else
        myFileExists = False
    End If
End Function


Sub DeleteStyles()

' Created by Scottiex 13092018

Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Dim newfile As String
file = Application.GetOpenFilename("Files (*.xlsm),*.xlsm", , "Browse For File")
FileNameFolder = "C:\"

newfile = rename_to_zip(file)

'Object for work with ZIP file
Set oApp = CreateObject("Shell.Application")
'Cycle trought Zip archive
For Each fileNameInZip In oApp.Namespace((newfile)).items
       'find xl folder
    If fileNameInZip = "xl" Then
       'find styles
       For Each subFile In fileNameInZip.Getfolder.items
            'extract 'styles' file
            If subFile = "styles" Then
                   ''Move xml file to tmp folder
                  oApp.Namespace(FileNameFolder).movehere subFile
                  ProjectFileFound = True
                  Exit For
            End If
       Next
    End If
Next

sFileName = "C:\styles.xml"

iFileNum = FreeFile
Open sFileName For Input As iFileNum

Do Until EOF(iFileNum)
    Line Input #iFileNum, sBuf
    sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
Start = InStr(sTemp, "< cellStyles") - 1
endit = InStr(sTemp, "/cellStyles>")

' now edit that file
sTemp = Left(sTemp, Start) & "< cellStyles count=""1"">< cellStyle name=""Normal"" xfId=""0"" builtinId=""0"" customBuiltin=""1"" />< " & Mid(sTemp, endit, 999999999)

iFileNum = FreeFile
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum

    'Overwrite existing styles file
    oApp.Namespace((newfile)).items.Item("xl").Getfolder.CopyHere "C:\styles.xml"

'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace((newfile)).items.Item("xl").Getfolder.items.Item("styles.xml").Name = "styles"

        Application.Wait (Now + TimeValue("0:00:01"))
    Loop

    On Error GoTo 0

'rename file
newfile = rename_to_xlsm(newfile)
            'Delete tmp files
 If myFileExists("C:\styles.xml") Then
        Kill "C:\styles.xml"
    End If
End Sub