' 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