title image


Smiley Re: Alternative zu @UserNamesList (Notes 5) in Notes 4.5
Hi



Aus der LoNo 6 Mailschablone, mußt Du nur etwas anpassen.



Liefert alle Personen aus der übergebenen Liste von Personen + Gruppen.



Gruß





Sub NABResolveAllNames()

Dim vSendTo As Variant

Dim vCopyTo As Variant

Dim vBlindCopyTo As Variant

Dim viewPGF As notesview

Set viewPGF = db.getView("($PeopleGroupsFlat)")

Dim vNewSendTo() As String

Dim vNewCopyTo() As String

Dim vNewBlindCopyTo() As String

Dim listSendTo List As String

Dim listCopyTo List As String

Dim listBlindCopyTo List As String

Dim listGroups List As String

Dim iCount As Integer



vSendTo = note.getitemvalue("SendTo")

Forall strName In vSendTo

Call NABResolveName( strName, listSendTo, viewPGF, listGroups )

End Forall



vCopyTo = note.getitemvalue("CopyTo")

Forall strName In vCopyTo

Erase listGroups

Call NABResolveName( strName, listCopyTo, viewPGF, listGroups )

End Forall



vBlindCopyTo = note.getitemvalue("BlindCopyTo")

Forall strName In vBlindCopyTo

Erase listGroups

Call NABResolveName( strName, listBlindCopyTo, viewPGF, listGroups )

End Forall



'convert lists to arrays

iCount = -1

Forall i In listSendTo

iCount = iCount + 1

End Forall

If (iCount > -1) Then

Redim vNewSendTo( iCount )

iCount = 0

Forall i In listSendTo

vNewSendTo( iCount ) = i

iCount = iCount + 1

End Forall

Call note.replaceItemValue("SendTo", vNewSendTo )

End If



iCount = -1

Forall i In listCopyTo

iCount = iCount + 1

End Forall

If (iCount > -1) Then

Redim vNewCopyTo( iCount )

iCount = 0

Forall i In listCopyTo

vNewCopyTo( iCount ) = i

iCount = iCount + 1

End Forall

Call note.replaceItemValue("CopyTo", vNewCopyTo )

End If



iCount = -1

Forall i In listBlindCopyTo

iCount = iCount + 1

End Forall

If (iCount > -1) Then

Redim vNewBlindCopyTo( iCount )

iCount = 0

Forall i In listBlindCopyTo

vNewBlindCopyTo( iCount ) = i

iCount = iCount + 1

End Forall

Call note.replaceItemValue("BlindCopyTo", vNewBlindCopyTo )

End If



End Sub





Sub NABResolveName( Byval strName As String, listResolved List As String, view As notesview, listGroups List As String)

Dim ve As notesviewentry

Dim colVals As Variant

Dim iCount As Integer



If strName = "" Then Exit Sub



'Try to resolve name locally

Set ve = view.getEntryByKey(strName, True)

If (ve Is Nothing) Then

listResolved( strName ) = strName

Exit Sub

End If



'This might be a person

colVals = ve.ColumnValues

If (colVals(4) = "Person") Then

listResolved( colVals(2) ) = colVals(2)

Else

' Group, try to resolve members

Dim docGroup As notesdocument



Set docGroup = ve.Document

If Iselement( listGroups( strName ) ) Then

Exit Sub 'pop up stack

End If



listGroups( strName ) = "1"

Forall strMember In docGroup.getitemvalue("Members")

Call NABResolveName( strMember, listResolved, view, listGroups )

End Forall

End If



End Sub






Gruß
_________________________
www.XLplus.de



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: