How much attachments are on your servers?

 


  'ScanForSize: 

  Option
  
  Public

  Option
  
  Declare

  Use
  
  "SizeTools"

  Sub
  
  Initialize

  Dim s
  
  As
  
  New
  
  NotesSession

  Dim db
  
  As
  
  NotesDatabase

  Dim curDB
  
  As
  
  NotesDatabase

  Dim dbDir
  
  As
  
  NotesDbDirectory

  Dim serverName
  
  As
  
  String

  Set db
  
  = s
  
  .CurrentDatabase

  If db
  
  .Server
  
  =
  
  ""
  
  Then
  serverName
  
  =
  
  "(local)"

  Else
  serverName
  
  = db
  
  .Server

  End
  
  If
 serverName
  
  =
  
  Inputbox
  
  (
  
  "Please select the server to scan (local) for local"
  
  ,
  
  "Server Scan"
  
  ,serverName
  
  )

  If serverName
  
  =
  
  ""
  
  Then
  
  Exit
  
  Sub

  End
  
  If

  If servername
  
  =
  
  "(local)"
  
  Then
  
  Set dbDir
  
  =
  
  New
  
  NotesDbDirectory
  
  (
  
  ""
  
  )

  Else
  
  Set dbDir
  
  =
  
  New
  
  NotesDbDirectory
  
  (serverName
  
  )

  End
  
  If

  Set curDB
  
  = dbdir
  
  .GetFirstDatabase
  
  (
  
  TEMPLATE_CANDIDATE
  
  )

  Do Until curDB
  
  Is
  
  Nothing
  
  Print
  
  "Working on "
  
  & curDB
  
  .FilePath
  
  Call countThis
  
  (curDB
  
  , db
  
  )
  
  Set curDB
  
  = dbDir
  
  .GetNextDatabase

  Loop

  Msgbox
  
  "Run completed"

  End
  
  Sub

  Sub countThis
  
  (curDB
  
  As
  
  NotesDatabase
  
  , reportDB
  
  As
  
  NotesDatabase
  
  )

  Dim curSize
  
  As DBSizeInfo

  On
  
  Error
  
  Resume
  
  Next

  Set curSize
  
  =
  
  New DBSizeInfo
  
  (curDB
  
  )

  Call curSize
  
  .count

  'We save only database information that has an attachment

  If curSize
  
  .AttachmentCount
  
  > 0
  
  Then
  
  Call curSize
  
  .save
  
  (reportDB
  
  )

  End
  
  If

  End
  
  Sub

 

 

  
'SizeTools:

Option Public
Option Declare

Public Class DBSizeInfo
Private db As NotesDatabase 'The database to be counted
Public DBSize As Variant 'Size of the database
Public AttachmentSize As Variant
Public AttachmentCount As Variant
Public DocumentCount As Variant
Public hasError As Boolean
Sub new (curDB As NotesDatabase)
Set db = curDB
hasError = False
End Sub
Public Function Count As Boolean
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Dim countResult As Variant
Dim sizeResult As Variant
On Error Goto Err_Count
If Not db.IsOpen Then
Call db.Open("","")
If Not db.IsOpen Then
'We could not open it
Print "Can't open " & db.FilePath
Count = False
Goto Exit_Count
End If
End If
DBSize = db.Size
AttachmentCount = 0
AttachmentSize = 0
DocumentCount = 0
Set dc = db.AllDocuments
Set doc = dc.GetFirstDocument
Do Until doc Is Nothing
If doc.HasEmbedded Then
Call getAttachmentSizes(doc)
End If
DocumentCount = DocumentCount + 1
Set doc = dc.GetNextDocument(doc)
Loop
Count = True 'If we got here it worked
Exit_Count:
Exit Function
Err_Count:
Print Error$ & " in Count in " & db.FilePath & " in line " & Cstr(Erl)
Count = False
hasError = True
Resume Exit_Count
End Function
Public Sub Save(reportDB As NotesDatabase)
Dim doc As NotesDocument
Dim v As NotesView
Dim searchkey(0 To 1) As String
On Error Goto Err_Save
Set v = reportDB.GetView("(LookupByServerAndPath)")
If v Is Nothing Then
Set doc = New NotesDocument(reportDB)
Else
If db.Server = "" Then
searchkey(0) = "(local)"
Else
searchkey(0) = db.Server
End If
searchkey(1) = Lcase(db.FilePath)
Set doc = v.GetDocumentByKey(searchkey,True)
If doc Is Nothing Then
Set doc = New NotesDocument(reportDB)
End If
End If
Call doc.ReplaceItemValue("Form","SizeReport")
Call doc.ReplaceItemValue("DBSize",Me.DBSize)
Call doc.ReplaceItemValue("AttachmentSize",Me.AttachmentSize)
Call doc.ReplaceItemValue("AttachmentCount",Me.AttachmentCount)
Call doc.ReplaceItemValue("DocumentCount",Me.DocumentCount)
If hasError Then
Call doc.ReplaceItemValue("ErrorFlag",1)
Elseif doc.HasItem("hasError") Then
Call doc.RemoveItem("ErrorFlag")
End If
If db.Server = "" Then
Call doc.ReplaceItemValue("ServerName","(local)")
Else
Call doc.ReplaceItemValue("ServerName",db.Server )
End If
Call doc.ReplaceItemValue("FilePath",Lcase(db.FilePath))
Call doc.Save(True,True)
Exit_Save:
Exit Sub
Err_Save:
Print Error$ & " in " & db.FilePath
Resume Exit_Save
End Sub
Private Sub getAttachmentSizes(doc As NotesDocument)
Dim attNames As Variant
Dim att As NotesEmbeddedObject
Dim result As Variant
result = 0
On Error Goto Err_getAttachmentSizes
attNames = Evaluate(|@Attachmentnames|, doc)
If attNames(0) <> "" Then
Forall an In attNames
Print "Checking Attachment " & an
Set att = doc.GetAttachment(an)
result = result + att.FileSize
Me.AttachmentCount = Me.AttachmentCount + 1
End Forall
End If
Exit_getAttachmentSizes:
Me.AttachmentSize = Me.AttachmentSize + result
Exit Sub
Err_getAttachmentSizes:
Print Error$ & " in getAttachmentSizes doc: " & doc.UniversalID
Resume Exit_getAttachmentSizes
End Sub
End Class