Hallo Freunde,
ich stecke in einer (vermutlichen) Kleinigkeit fest:
Ich möchte aus eingehenden Mails (Rechnungen) lediglich alle PDFs herauslösen und ins FileSystem speichern. Offensichtlich habe ich bisher keine Berührungspunkte mit MIME gehabt.
Ich habe bei Domino Support einen Schnipsel genommen und ihn auf meine Bedürfnisse angepasst.
Mein Problem ist die Zeile:
If (header.GetHeaderVal(True) = "attachment") Then
Hierbei greift "attachment" nicht. Der Code 'umfliegt' den darunterliegenden Code, da keine Übereinstimmung.
Wonach muss ich abfragen, wenns die PDF sein soll?
Anbei der Mime-Extraction-Code
While Not(mime Is Nothing)
Set header = mime.GetNthHeader("Content-Disposition")
If (Not header Is Nothing) Then
If (header.GetHeaderVal(True) = "attachment") Then
'if the Content-Disposition header exists then the filename parameter must be present
filename = header.GetParamVal("filename")
'strip off the quotation marks on the file name
filename = StrRight(filename, {"})
filename = StrLeft(filename, {"})
'open a file, get the content of the attachment, and write it to the file system
stream.Open FilePath1 & CStr(timestamp) & "_" & filename, "binary"
mime.GetContentAsBytes stream, True
stream.Close
End If
End If
Set mime = mime.GetNextEntity(SEARCH_DEPTH)
Wend
Danke Euch.
P.S.
Ich suche peinlicher Weise bereits seit gestern Mittag - auch die ansonsten aussagekräftige Domino Hilfe ist hierbei etwas dürftig.
Bis gestern habe ich das tatsächlich auch so gehandhabt, bis der Einkauf mir mitteilte, die Rechnung eines Absenders nicht im Filesystem liegt, aber die Mail bereits in den Mailordner "erledigt" verschoben wurde.
In diesem Fall hat die IF-Anweisung
If Not IsEmpty(rtitem.embeddedobjects) Then
Keine Übereinstimmung und springt raus. Bei allen anderen Mails bisher (und auch anderen seit gestern ankommenden) läuft das so. Nur dieser eine Absender (glaube ich zumindest), der seine Mail aus Apple OSX mit Mail versendet, da greift die Anweisung nicht.
hier der vollständige Code aus meinem Initialize des Agenten
Set s = New NotesSession
Set DB = s.Currentdatabase
Set Inbox = db.Getview("($Inbox)")
filepath1 = "d:\extract\orig\"
filepath2 = "d:\extract\kopie\"
RecipientTest = ""
' Get First Mail in Inbox
Set maildoc = Inbox.Getfirstdocument()
' Prepare to see, if Mail is Mime
s.ConvertMIME = False
Set mime = Maildoc.GetMIMEEntity
Do While Not maildoc Is Nothing
timestamp = InternationalDate(maildoc.Created) & "_" & TimeString(maildoc.Created)
Set rtitem = maildoc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
' Loop through all Attachments and extract them if they are PDF to FilePath1 and FilePath2
If Not IsEmpty(rtitem.embeddedobjects) Then
ForAll o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) And (LCase(Right(o.Name,3))="pdf") Then
Call o.ExtractFile ( FilePath1 & CStr(timestamp) & "_" & CStr(o.Name) )' orig
'Call o.ExtractFile ( FilePath2 & CStr(timestamp) & "_" & CStr(o.Name) )' kopie
End If
End ForAll
End If
Call maildoc.Putinfolder("Extrahierte Rechnungen", True)
Call maildoc.RemoveFromFolder("($Inbox)")
Call MailVersand
Else
' If Mail is Mime, then detaching is different
While Not(mime Is Nothing)
Set header = mime.GetNthHeader("Content-Disposition")
If (Not header Is Nothing) Then
If (header.GetHeaderVal(True) = "application") Then
'if the Content-Disposition header exists then the filename parameter must be present
filename = header.GetParamVal("filename")
'strip off the quotation marks on the file name
filename = StrRight(filename, {"})
filename = StrLeft(filename, {"})
'open a file, get the content of the attachment, and write it to the file system
stream.Open FilePath1 & CStr(timestamp) & "_" & filename, "binary"
mime.GetContentAsBytes stream, True
stream.Close
End If
End If
Set mime = mime.GetNextEntity(SEARCH_DEPTH)
Wend
s.ConvertMIME = True ' Restore conversion
Call maildoc.Putinfolder("Extrahierte Rechnungen", True)
Call maildoc.RemoveFromFolder("($Inbox)")
Call MailVersand
End If
' Next Doc is now the first doc
Set maildoc = Inbox.GetFirstdocument
Loop
Exit Sub
varFileNames = Evaluate( "@AttachmentNames", doc )
If varFileNames(0) <> "" then
Chris
Hallo und danke an Alle!!! Es hat nun auch bei diesem Absender geklappt.
Set maildoc = Inbox.Getfirstdocument()
Do While Not maildoc Is Nothing
timestamp = InternationalDate(maildoc.Created) & "_" & TimeString(maildoc.Created)
Set rtitem = maildoc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
' Loop through all Attachments and extract them if they are PDF to FilePath1 and FilePath2
If Not IsEmpty(rtitem.embeddedobjects) Then
ForAll o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) And (LCase(Right(o.Name,3))="pdf") Then
Call o.ExtractFile ( FilePath1 & CStr(timestamp) & "_" & CStr(o.Name) )' orig
'Call o.ExtractFile ( FilePath2 & CStr(timestamp) & "_" & CStr(o.Name) )' kopie
End If
End ForAll
Else
' Sometime the attachment is stored in the doc, not in a RTITEM
attNames = Evaluate("@AttachmentNames", Maildoc)
For i = 0 To UBound (attNames)
If (LCase(Right(attNames(i),3))="pdf") Then
Set MimeAtt = MailDoc.GetAttachment(attNames(i))
Call MimeAtt.ExtractFile ( FilePath1 & CStr(timestamp) & "_" & CStr(attNames(i)) )' orig
End if
Next
End If
Call maildoc.Putinfolder("Extrahierte Rechnungen", True)
Call maildoc.RemoveFromFolder("($Inbox)")
Call MailVersand
End If
' Next Doc is now the first doc
Set maildoc = Inbox.GetFirstdocument
Loop
Falls das jetzt irgendwer mal braucht, bzw. irgendwer mal optimieren möchte :-)