Lotus Notes — рабочий инструмент программиста.

Sub Initialize
‘ from the current view, removes a field or modifies a field in every document
‘ posted to http://www.openntf.org/Projects/codebin/codebin.nsf/CodeBySubCategory/A37FAED4F7480160862574F10071BAAA
‘ written by Mike Mortin 20081029
On Error Goto ErrorHandler
Dim s As NotesSession
Dim ws As New NotesUIWorkspace
Dim currentDb As NotesDatabase
Dim uiView As NotesUIView
Dim view As NotesView
Dim coll As notesViewEntryCollection
Dim entry As NotesViewEntry
Dim doc As NotesDocument
Dim field As String, newValue As String, msg As String, action As String
Dim items As Variant
Const kActionRemove = "remove"
Const kActionReplace = "replace"
Const kActionNone = ""
Const kMsgNoActionDone = "No changes made." ‘ setup
Set uiView = ws.CurrentView
Set view = uiView.View
Set coll = view.AllEntries ‘ get a list of all items
Set doc = coll.GetFirstEntry.Document
Forall item In coll.GetFirstEntry.Document.items
items = items & item.name & ","
End Forall ‘ tighten up the list
items = Split(items, ",")
items = Fulltrim(items)
items = Arrayunique(items) ‘ find out what action we are doing
If Msgbox("Click ‘No’ to replace values or to exit.", MB_YESNO, "Are you going to REMOVE a field?") = IDYES Then
action = kActionRemove
Elseif Msgbox("Click ‘No’ to exit.", MB_YESNO, "Then you must be REPLACING data in a field?") = IDYES Then
action = kActionReplace
Else
action = kActionNone
End If ‘ prompt for the item to change
If action <> kActionNone Then field = ws.Prompt(PROMPT_OKCANCELEDITCOMBO, "Please select the field you wish to " & action, "or enter a field manually.", "", items) Select Case action
Case kActionRemove
‘ verify the action
If Msgbox("Click ‘No’ to cancel.", MB_YESNO, "Are you sure you want to REMOVE " & field & " from all document in this view?") = IDYES Then
‘ loop through all docs in view and remove the item in question
Set entry = coll.GetFirstEntry
While Not entry Is Nothing
Set doc = entry.Document
‘ Call doc.RemoveItem(field)
‘ Call doc.Save(True,False)
Set entry = coll.GetNextEntry(entry)
Wend
msg = "Finished removing ‘" & field & "’ from all documents at " & Time()
Else
msg = kMsgNoActionDone
End If
Case kActionReplace
If Msgbox("This might take a few minutes as each document will be examined.", MB_YESNO, "Do you want see all the current values or type one in manually?") = IDYES Then
‘ grab all current entries
items = ""
Set entry = coll.GetFirstEntry
While Not entry Is Nothing
Set doc = entry.Document
items = items & doc.GetItemValue(field)(0) & ","
Set entry = coll.GetNextEntry(entry)
Wend ‘ tighten up the list
items = Split(items, ",")
items = Fulltrim(items)
items = Arrayunique(items) ‘ prompt for a new value
newValue = ws.Prompt(PROMPT_OKCANCELEDITCOMBO, "Please select the value you want to use", "or enter a value manually.", "", items)
Else
‘ prompt for a new value
newValue = Inputbox("Please enter the new value for ‘" & field & "")
End If ‘ verify the action
If Msgbox("Currently setting ‘" & field & "’ = ‘" & newValue &"’.", MB_YESNO, "Are you sure you want to set " & field & " = " & newValue & " for all documents in this view?") = IDYES Then
‘ Call coll.StampAll(field, newValue)
msg = "Finished stamping all documents with " & field & " = " & newValue & " at " & Time()
Else
msg = kMsgNoActionDone
End If
Case kActionNone
msg = kMsgNoActionDone
End Select ‘ fall through to print a message
ErrorHandler: If msg = "" Then msg = "Your action did not complete successfully. Please investigate. (" & Now() & ")" Msgbox msg
Exit Sub ‘ gets around "No Resume" error
End Sub

Function GetEnterpriseNAB( default As String ) As NotesDatabase
‘ returns the NAB from the server the current Db is on
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/808CDC4680D8BF37862574EF006EDD01
‘ written by Mike Mortin
Dim s As New NotesSession
Dim db As NotesDatabase
Dim server As String
Dim nname As NotesName ‘ set the default
If default = "" Then default = "Admin01/Operations/CA" ‘ get our parent server to get the NAB
Set db = s.CurrentDatabase
Set nname = New NotesName(db.Server)
server = nname.Common ‘ now, use default server if we are local
If server = "" Then server = default ‘ finally, grab names.nsf from that server
Set GetEnterpriseNAB = New NotesDatabase(server, "names.nsf")
End Function

Function IIf (condition As Variant, trueCondition As Variant, falseCondition As Variant) As Variant
‘ such a basic function for all other programming languages … stands for "Immediate IF"
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/328BED8C4AB8E446862574EF0068734A
‘ written by Mike Mortin
If condition Then
If Isobject(TrueCondition) Then
Set IIf = trueCondition
Else
IIf = trueCondition
End If
Else
If Isobject(TrueCondition) Then
Set IIf = falseCondition
Else
IIf = falseCondition
End If
End If
End Function

Function GetClusterServers(server As String, getAllServers As Boolean) As Variant
‘ returns a list of servers in cluster, given one server
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/71497FFD8E4531A7862574EF006567C5
‘ written by Mike Mortin 20081027 Dim s As New NotesSession
Dim cluster As String
Dim serverDoc As NotesDocument
Dim serverName As NotesName
Dim key(1 To 1) As Variant
Dim navDoc As NotesViewEntry
Dim nav As NotesViewNavigator ‘ define domain and name as per the default "Servers" view
Set serverName = New NotesName(server)
key(1) = serverName.Canonical
Set serverDoc = GetDocFromDb(s.CurrentDatabase, "($Servers)", key, True) ‘ get a list of servers in the same cluster
cluster = serverDoc.ClusterName(0) If cluster = "" Then
‘ if there is no cluster
GetClusterServers = Iif(getAllServers, serverName.Abbreviated, Null)
Else
‘ grab all server documents in the cluster
Set nav = GetCategoryDocsFromDb(currentDb, "Clusters", cluster) ‘ go through the category, add names to replica list, skip the submitted server if requested
Set navDoc = nav.GetFirstDocument()
While Not navDoc Is Nothing
Set serverDoc = navDoc.Document
If serverDoc.ServerName(0) <> server Or getAllServers Then
Set serverName = New NotesName(serverDoc.ServerName(0))
GetClusterServers = GetClusterServers & serverName.Abbreviated & ","
End If
Set navDoc = nav.GetNextDocument(navDoc)
Wend
End If ‘ tighten up the list
GetClusterServers = Split(GetClusterServers, ",")
GetClusterServers = Fulltrim(GetClusterServers)
End Function

Function GetCategoryDocsFromDb( db As NotesDatabase, viewName As String, category As String ) As NotesViewNavigator
‘ returns all docs from a given category
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/16B4DEA132579F6D862574EF00630D42
‘ written by Mike Mortin Dim view As NotesView ‘ get the view
Set view = db.GetView(viewName) ‘ get the docs from the cateogry
Set GetCategoryDocsFromDb = view.CreateViewNavFromCategory( category )
End Function

Public Function GetDocFromDb( db As NotesDatabase, viewName As String, key() As Variant, exact As Boolean ) As NotesDocument
‘ returns the first doc based on a search key
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/D8474BE8C4FEEB35862574EF00628013
‘ written by Mike Mortin
Dim view As NotesView ‘ get the view
Set view = db.GetView(viewName) ‘ get the doc from the key
Set GetDocFromDb = view.GetDocumentByKey(key, exact)
End Function

Public Function GetEmailCreatedDate(doc As NotesDocument) As String
‘ returns a date the document/email should be considered created
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeBySubCategory/1D9C645C986EAF74862574EF0061CBBB
‘ written by Mike Mortin 20080625
If doc.DeliveredDate(0) <> "" Then
GetEmailCreatedDate = doc.DeliveredDate(0)
Elseif doc.PostedDate(0) <> "" Then
GetEmailCreatedDate = doc.PostedDate(0)
Else
GetEmailCreatedDate = doc.Created
End If
End Function