Wäre durchaus möglich. Nur dann sollte aber doch die Formatierung trotzdem gleich bleiben oder?
edit:
hier noch der Code:
Option Public
Option Explicit
Sub Initialize
Dim ss As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim para As notesdocument
Dim doc As notesdocument
Dim root As String
Dim SendTo As Variant
Dim file As Variant
Set db = ss.currentdatabase
Set view = db.getview("all_rud")
Set doc = view.getFirstDocument
Set para = db.getProfileDocument("(Parameter)")
root = para.RootDir(0)
Do While Not doc Is Nothing
If doc.dir(0)= "fax" Then
SendTo = para.SendToo
SendTo = Arrayappend(SendTo , doc.getitemvalue("name"))
Call CreateSendMail(SendTo, doc.getfirstitem("body"), root+"\"+doc.dir(0), para)
End If
Set doc = view.getnextdocument(doc)
Loop
End Sub
Function CreateSendMail(SendTo2 As Variant, body As notesrichtextitem, path As String, para As notesdocument)As Integer
Dim ss As New notessession
Dim db As notesdatabase
Dim mail As notesdocument
Dim rti As notesrichtextitem
Dim i As Integer
Dim attached As Integer
Dim txt_file As String, subject As String
Dim FileNo As Integer, fl As Double
Dim items(5) As Variant
Dim tline As Variant
Dim sendto As Variant
Dim positionOfChar As Long
Dim pathName As String, fileName As String
On Error Resume Next
Set db = ss.currentdatabase
If Not para.attachment Is Nothing Then
For i = 0 To Ubound(para.attachment)
subject = para.Subject(i)
If para.attachment(i) = "fax.txt" Then
' FAX - Sendebericht
pathName$ = path+"\*.*"
fileName$ = Dir$(pathName$, 0)
Do While fileName$ <> ""
Set mail = New notesdocument(db)
Set rti = New NotesRichTextItem(mail, "Body" )
Call rti.appendrtitem(body)
Call rti.addnewline(2)
txt_file = path+"\"+fileName$
fileno = Freefile()
Open txt_file For Input As fileno
Line Input #fileno, tline
While(tline <> "")
On Error Resume Next
positionOfChar = Instr(1, tline, "@")
If positionOfChar = 0 Then
positionOfChar = Instr(1, tline, "#SUBJECT")
If positionOfChar = 0 Then
Call rti.appendtext(tline)
Call rti.addnewline(1)
Else
subject = Strright(tline, "#SUBJECT")
subject = Strleft(subject, "#")
End If
Else
sendTo = tline
End If
tline = ""
Line Input #fileNo, tline
If(tline = "") Then Line Input #fileNo, tline
Wend
Close fileNo
Call mail.replaceItemValue("SendTo",SendTo)
Call mail.replaceItemValue("CopyTo",SendTo2)
Call mail.replaceItemValue("Subject", subject)
Call mail.Send( False )
Kill txt_file
fileName$ = Dir$()
Loop
End If
Next
End If
' Ende FAX - Routine
Exit Function
End Function
Gruß Ralf
Thema: Agent ändert auszuführender Server jeden morgen (Gelesen 3123 mal)