'This Procedure Will Scan the Fields/Items in a Document, Collect Size Data

Sub ReportSize

'This procedure will scan the fields/items in a document, collect size data

'and output based on conditions and values. Used as a diagnostic tool

'in solving Field Size (32K) problem.

'Processing Notes======

'Copied from Agent Check Field Size

'Modified to run against selected documents instead of a view

'Notes Objects======

Dim Session As NotesSession

Dim DB As NotesDatabase

Dim TestColl As NotesDocumentCollection

Dim CurrDoc As NotesDocument

Dim TestItem As NotesItem

'Procedure Objects======

Dim DocCount As Integer

Dim FieldCount As Integer

Dim SummaryCount As Integer

Dim DocSize As Long

Dim FieldSum As Long

'Initalize Notes Objects=====

Set Session = New NotesSession

Set DB = Session.CurrentDatabase

Set TestColl = DB.UnprocessedDocuments

'Get First Document

Set CurrDoc = TestColl.GetFirstDocument

' Test collection to see if any documents selected

Select Case TestColl.Count

Case 0

' Nothing selected report and end

Msgbox "You have not selected any documents to operate upon.", 0 + 48 + 0 + 0, "You must select at least one document."

Exit Sub

Case 1, 2

'OK don't do anything but allow continue

Case Is > 2

'Greater then 2

Msgbox "You have selected " + Cstr(TestColl.Count) + " documents, this may be to many to display results.", 0 + 48 + 0 + 0, "If you do not see your results pick fewer documents."

Case Else

' Nothing selected report and end

Msgbox "Error in selection of documents to operate upon.", 0 + 48 + 0 + 0, "Error, exiting, call support."

Exit Sub

End Select

If TestColl.Count = 0 Then

End If

'Loop through collection reporting on each document

DocCount = 1

While Not(CurrDoc Is Nothing)

'Initalize Variables

FieldCount = 0

SummaryCount = 0

DocSize = CurrDoc.Size

FieldSum = 0

Forall Items In CurrDoc.Items

'Total Field Count

FieldCount = FieldCount + 1

'Removes Fields size from total doc size

DocSize = DocSize - Items.ValueLength

'Adds field size to Sum Count

FieldSum = FieldSum + Items.ValueLength

'Tests summary and counts or outputs non-summary field name

If (Items.IsSummary) Then

SummaryCount = SummaryCount + 1

'Special output for documents fitting range in bytes

'If Items.ValueLength > 1024 And Items.ValueLength < 2048 Then

If Items.ValueLength > 1024 And Items.ValueLength < 5120 Then

Print "Doc " + Cstr(DocCount) + " Type I > 1 KB & < 5 KB Item: " + Items.Name + " - Length: " + Cstr(Items.ValueLength) + "."

End If

'Special output for documents over certain size in bytes

If Items.ValueLength > 5120 Then

Print "Doc " + Cstr(DocCount) + " Type II > 5 KB Item: " + Items.Name + " - Length: " + Cstr(Items.ValueLength) + "."

End If

Else

'Print "Non-Summary Field : " + Items.Name + "."

End If

End Forall

'Output document details

'Print "Doc " + Cstr(DocCount) + " Totals for DocID: " + Cstr(CurrDoc.UniversalID) + "."

Print "Doc " + Cstr(DocCount) + " Total Fields Tested: " + Cstr(FieldCount) + "."

Print "Doc " + Cstr(DocCount) + " Doc.Size - Sum(Field.ValueLength) = " + Cstr(DocSize) + "."

'Print "Doc " + Cstr(DocCount) + " Sum(Field.ValueLength) = " + Cstr(CurrDoc.Size - DocSize)

Print "Doc " + Cstr(DocCount) + " Sum(Field.ValueLength) = " + Cstr(FieldSum)

Print "Doc " + Cstr(DocCount) + " Summary Field Count = " + Cstr(SummaryCount) + "."

'Setup for next document

Set CurrDoc = TestColl.GetNextDocument(CurrDoc)

DocCount = DocCount + 1

Wend

End Sub

Sub UncheckSumFlagSize

' Processing Notes======

' This procedure will scan the fields in a document and if found to be larger then

' ByteLimit (passed parameter), sets the IsSummary property to false

' Procedure Notes======

' The document will be selected in a view (possible multiples) and processed

' It will NOT be callable from a NotesUIDocument object

' Will have backend and front end classes so not able to run on server

' Frontend Notes Objects======

Dim WS As NotesUIWorkspace

' Backend Notes Objects======

Dim Session As NotesSession

Dim DB As NotesDatabase

Dim FixColl As NotesDocumentCollection

Dim CurrDoc As NotesDocument

Dim TestItem As NotesItem

'Procedure Variables======

Dim ByteLimit As Long

Dim UserResponse As Variant

Dim Choices (0 To 4) As String

Dim MessageString As String

Dim SaveNeeded As Integer

Dim DocFixed As Integer

'Initalize Notes Objects======

Set WS = New NotesUIWorkspace

Set Session = New NotesSession

Set DB = Session.CurrentDatabase

Set FixColl = DB.UnprocessedDocuments'All documents selected in current view

'Initalize Procedure Variables===

DocFixed = 0

' Test collection to see if any documents selected

If FixColl.Count = 0 Then

' Nothing selected report and end

Msgbox "You have not selected any documents to operate upon.", 0 + 48 + 0 + 0, "You must select at least one document."

Exit Sub

End If

'Modified by TBQ 2/21/02 to prompt for level between 1 - 5 KB

Choices(0) = "5"

Choices(1) = "4"

Choices(2) = "3"

Choices(3) = "2"

Choices(4) = "1"

MessageString = "Select threshold for setting IsSummary property to false." + Chr(10)

MessageString = MessageString +"Will eliminate ability to show field values in view, but" + Chr(10)

MessageString = MessageString +"will restore ability to save document changes and eliminate" + Chr(10)

MessageString = MessageString +"32K limit problems and error 400 messages in the log file." + Chr(10)

UserResponse = 0

UserResponse = Ws.Prompt(PROMPT_OKCANCELLIST, "Select IsSummary threshold in Kilobytes" , MessageString , "5", Choices)

' 1 KB = 1024 Bytes 5120 Bytes = 5 KB

If UserResponse > 0 Then

ByteLimit = 1024 * Int(UserResponse)

Else

Exit Sub

End If

'Report ByteLimit size in Bytes

Msgbox "This will modify IsSummary property for all fields larger then " + Cstr(ByteLimit) + " bytes.", 0 + 48 + 0 + 0, "Current threshold for IsSummary update."

Set CurrDoc = FixColl.GetFirstDocument

While Not(CurrDoc Is Nothing)

SaveNeeded = False

'Added By TBQ 3/28/02 to prevent change on locked documents

If LockedDoc(CurrDoc) = True Then

Print "Document skipped since locked (" + Cstr(DocFixed + 1) + ")."

Goto NextDoc

End If

'Clears flag for greater then a given size in bytes

Forall Items In CurrDoc.Items

'Larger then ByteLimit and NOT RichText (Type = 1)

'RichText by default are IsSummary = False

If Items.ValueLength > ByteLimit And Items.Type > 1 Then

Items.IsSummary = False

SaveNeeded = True

'Output changed field name and limit value

Print "Doc: " + Cstr(DocFixed + 1) + " , Item.Name : " + Items.Name + ", larger then Byte Limit of " + Cstr(ByteLimit) + "."

End If

End Forall

' Finished looping through all fields, if save needed update

If SaveNeeded = True Then

' Corrects SaveOptions flag, when "0" no changes saved, "1" changes saved

' Needed in some cases, always test to insure changes kept

If CurrDoc.GetItemValue("SaveOptions")(0) = "0" Then

Set TestItem = CurrDoc.ReplaceItemValue("SaveOptions" , "1")

End If

'Save changes for any process above

Call CurrDoc.Save (True, True)

DocFixed = DocFixed + 1

End If

NextDoc:

Set CurrDoc = FixColl.GetNextDocument(CurrDoc)

Wend

Select Case DocFixed

Case 0

Msgbox "You have NOT modified any documents.", 0 + 48 + 0 + 0, "IsSummary Property NOT Changed."

Case 1

Msgbox "You have modified " + Cstr(DocFixed) + " document.", 0 + 48 + 0 + 0, "IsSummary Property Changed."

Case Is > 1

Msgbox "You have modified " + Cstr(DocFixed) + " documents.", 0 + 48 + 0 + 0, "IsSummary Property Changed."

Case Else

Msgbox "Error, DocFixed = " + Cstr(DocFixed) + " .", 0 + 48 + 0 + 0, "IsSummary Property Changed but error in Count."

End Select

End Sub