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

问题

I'm creating a script in HP UFT 12 which performs grid data validation against a CSV file and saves the results in a Excel file with two worksheets.
I'm using Excel for this because it is much more clear for the user, as it allows cell formatting, is easier to compare the data and so forth.

My code works in my machine, but my client has TITUS document classification add-in installed, so every time they run my script, it hangs because of the TITUS pop-up message that asks user to classify the document upon saving. The message is not displayed to the user, probably because of objExcel.DisplayAlerts = False, but the script does not move forward.

Following is the portion of my code which is related to the matter (I have omitted most of the code, for confidentiality reasons).

Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Add
objExcel.Visible = False
Dim wsGrid : Set wsGrid = objWorkbook.Worksheets(1)
wsGrid.Name = "Grid Data"
Dim wsExported : Set wsExported = objWorkbook.Worksheets.Add
wsExported.Name = "Exported Data"

' Internal code to perform validation and fill worksheets ...

objExcel.DisplayAlerts = False
objWorkbook.SaveAs "C:\my_folder_path\my_file_name.xls"    ' This is where it hangs in machines where the add-in is installed
objWorkbook.Close
objWorkbook.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

I have searched online but haven't find anything related to it so far. I did find this and this, but they are related to TITUS for Outlook and in neither one the issue is properly solved.
Does anyone know how to solve this, or can point me to a research material to help me solve this issue?

Thanks in advance.

回答1:

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

回答2:

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?!

回答3:

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.

来源：https://stackoverflow.com/questions/38109265/how-to-save-workbook-and-handle-titus-or-any-other-document-classification-add

标签

excel

vbscript

QTP

hp-uft