We had the problem that more and more new computers crashed. All personal names.nsf are on the machines and are deleted. So I developed an agent to save all personal business cards and groups in the maildatabase of the users.
Code
Copy the masks of business cards and groups from the personal address book template into the maildatabase-Template. Copy the view ($People) also to the maildatabase. Make a copy of the ($People)-View and rename the new view to (searchpeople). Just use one column by using the field "type". The selection criteria of the view is:
"SELECT Type = "Person"|Type="Group"".
Put the following code to the
post-open-event of the maildatabase:
"user := @Name([CN];@UserName);
check :=@Environment("savedaddress");
checkuser := @Left(check;"|");
date := @Date(@Today);
checkdate := @Right(check;"|");
checkdate2 := @TextToTime(checkdate);
checkdays := ((date - checkdate2)/60/60)/24;
@If(checkdays <8;@Return("");"");
@Command([ToolsRunMacro];"savepersaddresses");
@SetEnvironment("savedaddress";user+"|"
+@Text(date))".
By using this postopen-event, the agent to save the addresses will start every 9 days while
opening the mail-database.
Agent Nr.1 to start the saving:
Mail-ToolsBusiness-Cards backup|savepersaddresses
options:
Option Public
Option Declare
Declarations:
Dim viewProfile As notesview
Dim docCalProfile As notesdocument
Dim s As String
Dim User As Notesname
Dim userabbr As String
Dim Owner As Notesname
Dim ownerabbr As String
Dim dbaddress As notesdatabase
Dim dbmail As notesdatabase
Dim dcaddress As notesdocumentcollection
Dim dcaddressmaildb As notesdocumentcollection
Dim searchformula As String
Dim searchformdelete As String
Dim searchfdname(1) As String
Dim docaddress1 As notesdocument
Dim docaddress2 As notesdocument
Dim viewaddressmaildb As notesview
Dim docaddmaildb1 As notesdocument
Dim docaddmaildb2 As notesdocument
Sub Initialize
Dim session As New notessession
Set dbaddress = Session.GetDatabase
( "", "names.nsf" )
Set dbmail = session.currentdatabase
Set docCalProfile=dbmail.
GetProfileDocument("CalendarProfile")
s=docCalProfile.getItemValue("Owner")(0)
Set Owner=New Notesname (s)
Set User=New Notesname (session.Username)
ownerabbr = Owner.Abbreviated
userabbr = user.abbreviated
If Not ownerabbr = userabbr Then Exit Sub
searchformdelete = "Type"
searchfdname(0) = "Person"
searchfdname(1) = "Group"
If dbaddress Is Nothing Then Exit Sub
Dim dateTime As New NotesDateTime("Today")
Dim i As Integer
i=0
Do Until i = 2
Set viewaddressmaildb = dbmail.getview("searchpeople")
'Set docaddmaildb1 =
viewaddressmaildb.getfirstdocument
Set dcaddressmaildb =
viewaddressmaildb.GetAllDocumentsByKey(searchfdname(i))
If Not dcaddressmaildb.count = 0 Then
Call dcaddressmaildb .removeall(True)
End If
i=i+1
Loop
i=0
Do Until i = 2
searchformula = "SELECT "
&"(" & searchformdelete & | = | & |"|
& searchfdname(i) & |"| & ")"
Set dcaddress = dbaddress.Search(searchFormula, dateTime, 0)
Set docaddress1 = dcaddress.getfirstdocument
Do Until docaddress1 Is Nothing
Set docaddress2 = dcaddress.getnextdocument(docaddress1)
Call docaddress1.copytodatabase(dbmail)
Set docaddress1 = docaddress2
Loop
i=i+1
Loop
End Sub"
All the existing addresses are deleted and all the local cards are copied.
Agent2 to recover the cards:
Mail-ToolsRestore business cards
Options:
Option Public
Option Declare
Declarations:
Dim viewProfile As notesview
Dim docCalProfile As notesdocument
Dim s As String
Dim User As Notesname
Dim userabbr As String
Dim Owner As Notesname
Dim ownerabbr As String
Dim dbaddress As notesdatabase
Dim dbmail As notesdatabase
Dim info As Variant
Dim dcaddress As notesdocumentcollection
Dim dcaddressmaildb As notesdocumentcollection
Dim searchformula As String
Dim searchformdelete As String
Dim searchfdname(1) As String
Dim docaddress1 As notesdocument
Dim docaddress2 As notesdocument
Dim viewaddressmaildb As notesview
Dim docaddmaildb1 As notesdocument
Dim docaddmaildb2 As notesdocument
Sub Initialize
Dim session As New notessession
Dim ws As notesuiworkspace
Dim Aend As Integer
Aend = Msgbox ("You wan't to restore
your business cards to your personal addressbook?"
, 4+32, "Restore business cards?")
If Aend = 7 Then
Exit Sub
Else
End If
Aend = Msgbox ( "You should only use this agent
if you don't have any cards in your personal
addressbook!" , 4+32,"Restore business cards?")
If Aend = 7 Then
Exit Sub
Else
End If
Set dbaddress = Session.GetDatabase
( "", "names.nsf" )
Set dbmail = session.currentdatabase
Set docCalProfile=dbmail.GetProfileDocument(
"CalendarProfile")
s=docCalProfile.getItemValue("Owner")(0)
Set Owner=New Notesname (s)
Set User=New Notesname (session.Username)
Ownerabbr = Owner.Abbreviated
Userabbr = user.abbreviated
If Not ownerabbr = userabbr Then
info = Messagebox ("You are not the owner of
the database. The agent is stopped.!
" , 0+16, "
Kein Eigentuemer!")
Exit Sub
End If
searchformdelete = "Type"
searchfdname(0) = "Person"
searchfdname(1) = "Group"
If dbaddress Is Nothing Then Exit Sub
Dim dateTime As New NotesDateTime("Today")
Dim i As Integer
i=0
Do Until i = 2
Set viewaddressmaildb =
dbmail.getview("searchpeople")
Set dcaddressmaildb = viewaddressmaildb.
GetAllDocumentsByKey(searchfdname(i))
Set docaddress1 = dcaddressmaildb.getfirstdocument
Do Until docaddress1 Is Nothing
Set docaddress2 =
dcaddressmaildb.getnextdocument(docaddress1)
Call docaddress1.copytodatabase(dbaddress)
Set docaddress1 = docaddress2
Loop
If dcaddressmaildb.count = 0 Then
info = Messagebox ("Es sind keine
Visitenkarten zum RÜcksichern gefunden
worden", 0+16, "Keine Visitenkarten vorhanden")
Exit Sub
End If
i=i+1
Loop
End Sub"
