Autor Thema: Anhang aus Maske in Memo einfügen  (Gelesen 1854 mal)

Offline mariab

  • Aktives Mitglied
  • ***
  • Beiträge: 123
Anhang aus Maske in Memo einfügen
« am: 20.07.05 - 08:15:23 »
Hallo,

in einer Maske gibt es mehrere Felder unter anderem auch ein RichText Field in welchem der Benutzer Anhänge einfügen kann.
Hat der Benutzer alle Felder ausgefüllt, kann er durch klicken auf eine Aktionsschaltfläche ein neues Memo erstellen. Dabei werden die Felder aus der Maske übernommen.
Hier der Code der Aktionsschaltfäche:
@Command([MailComposeMemo]);
@Command([EditGotoField];"EnterSendTo");
@Command([EditInsertText];TmpMail);
@Command([EditGotoField];"Subject");
@Command([EditInsertText];KurzBesch);
@Command([EditGotoField];"Body");
@Command([EditInsertText];Besch);
@Command([EditInsertFileAttachment];Anhang);

Im Memo erscheint die Fehlermeldung"Datei nicht vorhanden".
Kann ich dies mit der Formelsprache lösen? Kenne mich mit Lotus Script leider zu wenig aus.

klaussal

  • Gast
Re: Anhang aus Maske in Memo einfügen
« Antwort #1 am: 20.07.05 - 08:21:46 »
RT-Felder werden erst beim Speichern angelegt.
Frage: wird deine also Maske vorher gespeichert ?

Offline diali

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.023
  • Geschlecht: Männlich
Re: Anhang aus Maske in Memo einfügen
« Antwort #2 am: 20.07.05 - 08:23:55 »
bitte verlinken, wenn in mehreren Foren gepostet wird!

www.dominoforum.de
Gruß
Dirk

Offline mariab

  • Aktives Mitglied
  • ***
  • Beiträge: 123
Re: Anhang aus Maske in Memo einfügen
« Antwort #3 am: 20.07.05 - 08:32:39 »
Ja die Maske wird zuerst gespeichert.

Offline robertpp

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 940
  • Geschlecht: Männlich
Re: Anhang aus Maske in Memo einfügen
« Antwort #4 am: 20.07.05 - 08:36:12 »
Ich finde es ein wenig mühsam wenn immer alles in zwei Foren geschrieben wird. Um dann nachzusehen ob es da vielleicht schon eine Lösung gibt oder noch nicht.

Ich hab hier mal ein Script verwendet das auch noch eine Dialogbox zur Auswahl der Attachments hat und es waren mehrere RTF in der Maske.
Vielleicht bekommst du es hin dir das heraus zu nehmen was du brauchst.

Zitat
Sub Click(Source As Button)
   Dim s As New NotesSession
   Dim db As NotesDatabase
   Dim maildb As NotesDatabase
   Dim ws As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim doc As NotesDocument
   Dim memo As NotesDocument
   Dim RTItem As NotesRichtextItem
   Dim mailf As String
   Dim server As String
   Dim tempDrive As String
   Dim Filepath() As String
   Dim attachArray() As String
   tempDrive = "C:\temp"
   Redim attachArray(0)
   Set db=s.CurrentDatabase
   Set uidoc = ws.CurrentDocument
   Set doc = uidoc.Document
   If Dir$(tempDrive,16) = "" Then
      dirflag="true"
      Mkdir tempDrive
   End If
   If doc.HasEmbedded Then
      Forall Item In doc.Items
         If ( Item.Type = RICHTEXT ) Then
            If Not Isempty(Item.embeddedobjects) Then
               Forall obj In Item.EmbeddedObjects
                  If ( obj.Type = EMBED_ATTACHMENT ) Then
                     If attachArray(0) ="" Then
                        attachArray(0) = Cstr(Ubound(attachArray)+1) & ". " & obj.Name
                     Else
                        Redim Preserve attachArray(Ubound(attachArray)+1)
                        attachArray(Ubound(attachArray)) = Cstr(Ubound(attachArray)+1) & ". " & obj.Name
                     End If
                  End If
               End Forall
            End If
         End If
      End Forall
      
      Dim dlgDoc As NotesDocument
      Set dlgDoc = New NotesDocument(db)
      dlgDoc.AttachmentsList = attachArray
      ret = ws.DialogBox( "#DlgChooseAttachmail", True, True, False, False, False, False, "Attachment chooser", dlgDoc)
      If ret Then
         pos = Val(Left(dlgDoc.DlgAttachments(0), Instr(dlgDoc.DlgAttachments(0), ".")))
         Redim attachArray(0)
         Forall attachpos In dlgdoc.DlgAttachments
            If attachArray(0) ="" Then
               attachArray(0) = Strright(attachpos,". ")
            Else
               Redim Preserve attachArray(Ubound(attachArray)+1)
               attachArray(Ubound(attachArray)) = Strright(attachpos,". ")
            End If
         End Forall
         Call dlgdoc.Remove (True)
         
         Redim Filepath(0)
         Forall Item In doc.Items
            If ( Item.Type = RICHTEXT ) Then
               If Not Isempty(Item.embeddedobjects) Then
                  Forall obj In Item.EmbeddedObjects
                     If ( obj.Type = EMBED_ATTACHMENT ) Then
                        Forall posi In attachArray
                           If(obj.Name = posi ) Then
'                              Msgbox (posi + " = "+ obj.Name)
                              Call obj.ExtractFile ( tempDrive & "\" & obj.Source )
                              If Filepath(0) ="" Then
                                 Filepath(0) = tempDrive  & "\" & obj.Source
                              Else
                                 Redim Preserve Filepath(Ubound(Filepath)+1)
                                 Filepath(Ubound(Filepath)) = tempDrive  & "\" & obj.Source
                              End If
                           End If
                        End Forall
                     End If
                  End Forall
               End If
            End If
         End Forall
         
         mailf = s.GetEnvironmentString ("MailFile", True)
         server = s.GetEnvironmentString ("MailServer", True)
         Set maildb = New Notesdatabase (server, mailf)
         Set memo = maildb.CreateDocument
         With memo
            .Form = "memo"
            .Subject = "Änderungscheckliste " & doc.Project(0)
            .SendTo = ""
         End With
         Set RTItem = New NotesRichTextItem( memo, "Body" )
'         Call RTItem.AppendText( "" )
         Call RTItem.AddNewLine( 1 )
         Forall filesi In Filepath
            Set object = RTItem.EmbedObject( EMBED_ATTACHMENT , "" ,  filesi )
         End Forall
         Call doc.Save( True , False )
         doc.SaveOptions = "0"
         success = memo.ComputeWithForm( True, False )
         If success Then
'            Call memo.Save( True, True )
         End If
         Call ws.EditDocument (True, memo)
         Set doc = uidoc.Document
         If doc.HasItem("SaveOptions") Then
            doc.RemoveItem("SaveOptions")
            Call doc.Save( True ,False)
         End If
         Forall obji In Filepath
            Kill obji
         End Forall
'      Else
'         Msgbox (posi +" Keine Übereinstimmung!")
'         Exit Sub
      End If
   Else
      Messagebox "No embedded objects found",16,"Falsche oder fehlender Wert"
   End If
   If dirflag = "true" Then
      Rmdir tempDrive
   End If
End Sub
------------------------------------------------------------
1250 Notes User Client von 5.0.5 bis 6.5.4     WIN2000, XP
14 Notes Server von 6.5 bis 6.5.4 WIN2000, XP

32   Notes Server von 5.0.1 bis 6.5.4 in unserer Domain
323 Notes Server weltweit mit 38000 User in einem Adressbuch

 

Impressum Atnotes.de  -  Powered by Syslords Solutions  -  Datenschutz