Das Notes Forum
Domino 9 und frühere Versionen => Administration & Userprobleme => Thema gestartet von: RathMa am 12.03.02 - 14:53:28
-
Ich bekomme am Tag mehre E-Mail (ca 180) mit einen anhang in den das wichtige steht. gibt es eine möglichkeit nur duch makiren der mail alle anhänge in einen festen ordner zu lösen ohne sagen zu müssen wohin? mein erster ansatz war mit @Command([AttachmentDetachAll]), da muß ich aber leider immer noch ordner auswählen und mit ok bestätigen je email
währe wüch mich eine risen hilfe
thx
Markus
-
Habe dies in meiner Sammlung von Notes Zaubersprüchen und Beschwörungen gefunden
:o ::) ??? 8) ;D
The following script detaches all file attachments from all mail messages saving them into C:/ReceivedFiles, C:/SentFiles or C:/OtherFiles depending in their original location (received/sent messages or calendar entries). Users can decide whether to remove detached files or leave them in the mail file. Multiple files with the same file name are renamed by adding a "c_" in front of the original file name.
Dim sess As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim FilePresent As String
Dim FileName As String
Dim sDir As String
Dim i As Integer
Dim path As String
i = Msgbox ("YES = Detach AND Remove" & Chr(13) & Chr(13) & "NO = Detach but don't remove" & Chr(13) & _
Chr(13) & "CANCEL = I was joking, do nothing!",35,"Remove attachments?") 'Ask whether remove attachments or not
'If user chooses CANCEL then exit program
If i = 2 Then
Exit Sub
End If
'Check for the presence of destination folders and creates them if missing;
sDir = Dir$("C:/ReceivedFiles",16)
If sDir = "" Then
Mkdir "C:/ReceivedFiles"
End If
sDir = Dir$("C:/SentFiles",16)
If sDir = "" Then
Mkdir "C:/SentFiles"
End If
sDir = Dir$("C:/OtherFiles",16)
If sDir = "" Then
Mkdir "C:/OtherFiles"
End If
'---------------------------------------------------------
Set db = sess.CurrentDatabase
Set view = db.GetView("($All)")
Set doc = view.GetFirstDocument
Do Until doc Is Nothing
If doc.HasEmbedded Then 'Checks for presence of embedded objects
If doc.HasItem("DeliveredDate") Then
path = "C:/ReceivedFiles"
Else
If doc.HasItem("POSTEDDATE") Then
path = "C:/SentFiles"
Else
path = "C:/OtherFiles"
End If
End If
Set rtitem = doc.GetFirstItem("Body")
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
FileName = o.Source
FilePresent = Dir$(path & FileName,0)
'If current filename is already present in the directory then renames the destination file and checks again
If FilePresent <> "" Then
Do Until FilePresent = ""
FileName = "c_ " & FileName
FilePresent = Dir$(path & FileName,0)
Loop
End If
Call o.ExtractFile(path & FileName )
Print "Extracting " & o.Source
'If user pressed YES in the initial msgbox then removes attachments
If i = 6 Then
Call o.Remove
Call doc.Save( False, True )
End If
End If
End Forall
End If
Set doc = view.GetNextDocument(doc)
Loop
-
Und hier noch eien Lösung:
Here is the sample code for detaching attachments from a
rich text field.The specified folder in ExtractFile method should already exist.
Copy this code in a view action button and make a try.
Dim object As NotesEmbeddedObject
Dim cdoc As NotesDocument
Dim doccol As NotesDocumentCollection
Dim db As NotesDatabase
' --- Setting values
Set sess=New notessession
Set db=sess.CurrentDatabase
Set doccol = db.Unprocesseddocuments
For i = 1 To doccol.Count
Set cdoc=doccol.GetnthDocument(i)
AttName=Evaluate(| @AttachmentNames |,cdoc)
Forall attachments In AttName
Set object = cdoc.GetAttachment(Attachments)
Call object.ExtractFile("c:\Attach\" & Attachments)
End Forall
Next