Hallo,
Ich hab mir ein script gebastelt wenn ich es mit dem Scriptdebugger durchgehe dann ist das Attachment im Body-Field, sobald ich aber das Script ohne Debugger laufen lasse hängt das Attachment immer hinter der durchgezogenen Linie am Ende des doc's. Weiß jemand warum?
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, server, tempDrive, Filepath As String
Dim attachArray() As String
tempDrive = "C:\temp"
Set db=s.CurrentDatabase
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
If Dir$(tempDrive,16) = "" Then
dirflag="true"
Mkdir tempDrive
End If
Redim attachArray(0)
attachArray(0)="aecheckft.xls"
' attachArray(1)="aecheckro.xls"
Forall posi In attachArray
If posi ="" Then
Exit Forall
Else
' Msgbox (posi)
End If
End Forall
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 )
Filepath = tempDrive & "\" & obj.Source
mailf = s.GetEnvironmentString ("MailFile", True)
server = s.GetEnvironmentString ("MailServer", True)
Set maildb = New Notesdatabase (server, mailf)
Set memo = maildb.CreateDocument
memo.Form = "memo"
memo.Subject = "Änderungscheckliste " & doc.Project(0)
memo.SendTo = ""
' memo.Body = " "
' Set Item = memo.GetFirstItem( "Body" )
Set RTItem = New NotesRichTextItem( memo, "Body" )
Set object = RTItem.EmbedObject( EMBED_ATTACHMENT , "" , Filepath )
Call doc.Save( True , False )
doc.SaveOptions = "0"
Call ws.EditDocument (True, memo)
Kill Filepath
' Else
' Msgbox (posi +" Keine Übereinstimmung!")
End If
End Forall
End If
End Forall
End If
End If
End Forall
' Kill Filepath
End Sub
danke robert