How to save workbook and handle TITUS (or any other document classification add-in) popup?

随声附和 提交于 2019-12-04 15:01:25

As ridiculously simple as it looks (I don't know how I haven't thought of this before), I manage to solve my issue by simply adding objExcel.EnableEvents = False before saving the file:

objExcel.DisplayAlerts = False
objExcel.EnableEvents = False   ' this is the problem solver for the matter!
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls"
objExcel.EnableEvents = True    ' Not sure if this statement is necessary, though
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

So far as I can tell, none of the above answers actually classify the Excel workbook (and I found this on our work intranet having failed to find any code on the internet).

The code below should set Classification as Internal which can be amended as you need, and will also create the footer text based on 'ClassificationVal'.

Code then sets the classification, adds the left footer and removes the annoying page breaks at the same time (note: setting classification automatically sets page breaks).

Disabling events before save seems to be the only way to avoid the pop up box...

Note: you will need to replace '[Company Name]-' with e.g. 'IBM-' (if your company adds it's name to the classification, and delete '[Company Name]-' if they use the TITUS classification only. Also, the classifications seem to be bespoke to each company from my experience, so you may need to update accordingly.


ClassificationVal = "[Company Name]-1nternal"

ClassificationDesc = "[Company Name]: "
ClassificationDesc2 = ""
    Select Case ClassificationVal
        Case "[Company Name]-1nternal"
            ClassificationDesc2 = "Internal"
        Case "[Company Name]-pub1ic"
            ClassificationDesc2 = "Public"
        Case "[Company Name]-Confidentia1"
            ClassificationDesc2 = "Confidential"
        Case "[Company Name]-5ecret"
            ClassificationDesc2 = "Secret"
        Case "[Company Name]-pr1vate"
            ClassificationDesc2 = "Private"
    End Select
    If ClassificationDesc2 = "" Then Stop
ClassificationDesc = ClassificationDesc & ClassificationDesc2

With ActiveWorkbook.CustomDocumentProperties
     .Add Name:="[Company Name]Classification", _
     LinkToContent:=False, _
     Type:=msoPropertyTypeString, _
     Value:=ClassificationVal
End With

For Each ws In ActiveWorkbook.Worksheets
    ws.PageSetup.LeftFooter = ClassificationDesc
    ws.DisplayPageBreaks = False
Next ws

Application.EnableEvents = False    'disable TITUS pop-up

ActiveWorkbook.SaveAs Filename:= _
        "C:\Data\kelvinj\My Documents\TITUS Test.xlsx", 'Change to suite your requirements
             FileFormat:=xlOpenXMLWorkbook _
             , CreateBackup:=False

Application.EnableEvents = True

Not sure why this is so hard to find a solution to - this is the 2nd multinational company I've worked for to be infected by TITUS, so there must be loads of people needing this code surely?!

I am not a VBA coder but my friends were working on this

The solution we found was on the behaviour of Titus

It will ask you to classify any new workbook when u save it. Note new not an already saved workbook. So we created a blank workbook and saved it(with the required classification)

Amended the code to take that workbook and add data to it and using save as to create the required files

It works smoothly without any issues.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!