Leggere i contatti dalla Names Locale e formattarli in XLM

Questo script messo un un bottone e' stato preso dalla rete e serve come dimostrazione per leggere i contatti della NAMES locale e prepararli per la spedizione formattandoli in formato XML..

**************************************
Sub Click(Source As Button)
        Dim s As New NotesSession
        Dim ws As New NotesUIWorkspace
        Dim Uidoc As NotesUIDocument
        Dim db As New NotesDatabase("","")
        Dim doc As NotesDocument
        Dim view As NotesView
        Dim UserName As String
        UserName = s.CommonUserName
        Set uidoc = ws.CurrentDocument
        'Set db = s.currentDatabase
        If db.Open("","names.nsf") Then
                Set view = db.GetView( "Contacts" )
                Set doc = view.GetFirstDocument
'                UserName = CleanName(UserName)
                MYSTRING = MYSTRING &  ||  'Prevents Domino from sending default headers.
               
                MYSTRING = MYSTRING &  "<" & CleanNameText(UserName) & "_contacts>"   'Orders is the root element of the XML document.        
               
                While Not ( doc Is Nothing )
'Loop as long as there are document objects available.
                        MYSTRING = MYSTRING &   ""
   'collect contact elements for each contact document.
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc. FirstName(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc. LastName(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(doc.MiddleInitial(0))+""
                       
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.CellPhoneNumber(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficePhoneNumber(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficeFAXPhoneNumber(0)))+""
                       
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.PhoneNumber(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.MailAddress(0)))+""
                       
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficeStreetAddress(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficeCity(0)))+""                
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficeState(0)))+""
                        MYSTRING = MYSTRING &  ""+FixChars(Cstr(doc.OfficeCountry(0)))+""
                       
                        MYSTRING = MYSTRING &  ""+FixChars(doc. OfficeZip(0))+""
                        MYSTRING = MYSTRING &  ""
   'Close the contact element tag.
                        Set doc = view.GetNextDocument( doc )
   'Get the next document in the view.
                Wend
                MYSTRING = MYSTRING &  ""
                'Msgbox MYSTRING
                Call uidoc.FieldAppendText("XMLContacts",MYSTRING)
               
                uidoc.Refresh
        End If
End Sub

Function FixChars(TextData As String) As String
   'Replace unallowed XML chars.
       
        F_XML=""
        For i=1 To Len(TextData)
                MyChar=        Mid(TextData,i,1)
                Select Case MyChar
                Case  "<"
                        F_XML= F_XML & "&lt;"
                Case ">"
                        F_XML= F_XML & "&gt;"
                Case |"|
                        F_XML= F_XML & "&quot;"
                Case "'"
                        F_XML= F_XML & "&apos;"
                Case "&"
                        F_XML= F_XML & "&"
                Case Else
                        F_XML= F_XML & MyChar                        
                End Select        
        Next
        FixChars=F_XML
       
       
End Function



Function CleanNameText(NameText As String) As String
   'Used to replace a part of a text string with a new text string.
       
        F_XML=""
        For i=1 To Len(NameText)
                MyChar=        Mid(NameText,i,1)
                Select Case MyChar
                Case  "<"
                        F_XML= F_XML & "&lt;"
                Case ">"
                        F_XML= F_XML & "&gt;"
                Case |"|
                        F_XML= F_XML & "&quot;"
                Case "'"
                        F_XML= F_XML & "&apos;"
                Case " "
                        F_XML=F_XML & "_"
                Case "&"
                        F_XML= F_XML & "&"
                Case Else
                        F_XML= F_XML & MyChar                        
                End Select        
        Next
        CleanNameText=F_XML
End Function
**************************************

La fonte ufficiale e' presente qui