Hier ein QuickHack:
Fuege folgenden Code in die Lib LS.Ticket hinter der letzten Funktion ein.
Public Function CreateFromMailOther ( strView As String ) As Boolean
CreateFromMailOther = False
Dim uiws As New NotesUIWorkspace
Dim s As New NotesSession
Dim dbThis As NotesDatabase
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim dbMail As NotesDatabase
Dim docMail As NotesDocument
Dim docTicket As NotesDocument
Dim collMail As NotesDocumentCollection
Dim namesfield As Variant
Set dbThis = s.CurrentDatabase
Set dbMail = Nothing
Set dbMail = New NotesDatabase("[b]DeinServer[/b]","[b]DieDatenbank[/b]")
'Call dbMail.OpenMail
If Not dbMail.IsOpen Then Error 1001, "Could not open user's mailfile"
Set collMail = uiws.PickListCollection ( PICKLIST_CUSTOM, False, dbMail.Server, dbMail.FilePath, _
strView, "Transform Mail To Ticket", "Please select an e-Mail: ")
If collMail.Count = 0 Then Exit Function 'No document selected
Set docMail = collMail.GetFirstDocument
Set docTicket = Me.Create
Set item = docTicket.ReplaceItemValue ( "TransformMail", "1" )
Set item = docTicket.ReplaceItemValue ( "EnteredBy", "0" )
Set item = docMail.GetFirstItem( "Subject" )
Set item = docTicket.ReplaceItemValue ( "Problem", item.text )
Set item = docMail.GetFirstItem( "From" )
Set item = docTicket.ReplaceItemValue ( "user", item.text )
' build the reader and the authors field if necessary
If Ucase(Me.GetConfiguration("LockDocumentsgeneral"))="YES" Then
' create the readers field
namesfield = CreateNamesField(docTicket,"LockDocumentsTicketReaders")
If Isarray( namesfield) = True Then
Set item = docTicket.ReplaceItemValue("AReaders",namesfield)
item.IsReaders = True
End If
' create the authors field
namesfield = CreateNamesField(docTicket,"LockDocumentsTicketAuthors")
If Isarray( namesfield) = True Then
Set item = docTicket.ReplaceItemValue("AAuthors",namesfield)
item.IsAuthors = True
End If
End If
Dim AppendMailAsReponse As Boolean
AppendMailAsReponse = False
If Me.GetConfiguration ( "CREATE_FROM_MAIL_APPEND" ) = "YES" Then
' CREATE_FROM_MAIL_APPEND ( DEFAULT = NO )
AppendMailAsReponse = True
End If
If docMail.HasItem ( "Body" ) And Not AppendMailAsReponse Then
Set rtItem = New NotesRichTextItem (docTicket, "Body" )
Call rtItem.AppendRTItem (docMail.GetFirstItem( "Body" )) ' Get Mail Body
Call docTicket.Save (True, True )
Else
Call docTicket.Save (True, True )
Dim newmaildocUNID As String
newmaildocUNID = MoveToOtherDocument( dbthis, docMail, docTicket.UniversalID )
End If
CreateFromMailOther = True
End Function
Set dbMail = New NotesDatabase("DeinServer","DieDatenbank")
an den fett markierten Stellen must du entspechende Werte eintragen.
Dan aenderst du den Aufruf in der ShearedAction "TransformMail" in
Sub Click(Source As Button)
Dim ok As Boolean
Dim t As New Ticket ' Create BE Ticket Object
ok = t.CreateFromMailOther ( "($inbox)" )
End Sub
Fertig ...