| Option Public |
| Option Declare |
| Sub Initialize |
| On Error Goto fehler |
| Print "iPhone Mail Test" |
| |
| Dim session As New NotesSession |
| session.ConvertMime = False |
| |
| Dim db As notesdatabase |
| Dim dc As notesdocumentcollection, doc As notesdocument, rtitem As notesrichtextitem |
| Dim fehler As Integer |
| fehler = 0 |
| Dim docHasError As Boolean |
| |
| Set db= session.currentdatabase |
| Dim agentLog As New NotesLog("Logbuch") |
| Call agentLog.Openmaillog(session.Username, "iPhone Mailtest in " + db.Title) |
| Call agentLog.LogAction("Start...") |
| Set dc = db.Unprocesseddocuments |
| Set doc = dc.getfirstdocument |
| |
| Dim findEmbedded As Boolean |
| |
| While Not doc Is Nothing |
| docHasError = false |
| findEmbedded = False |
| 'Body |
| Dim hasEmbedded As Boolean |
| hasEmbedded = false |
| If doc.Hasembedded then |
| Call agentlog.Logaction(doc.subject(0) + " hat Embedded Objects") |
| hasEmbedded = True |
| else |
| Call agentlog.Logaction(doc.subject(0) + " hat keine Embedded Objects") |
| hasEmbedded = false |
| End If ' hasembedded |
| ForAll item In doc.Items |
| If ( item.Type = RICHTEXT ) Then |
| Call agentlog.Logaction( "item: " + item.name) |
| Call agentlog.Logaction( "is richtext") |
| Set rtitem = item |
| If rtitem Is Nothing Then |
| Call agentlog.Logaction( "rtitem Is Nothing") |
| Goto nextitem |
| End If |
| |
| If Not( Isempty(rtitem.EmbeddedObjects)) Then |
| findEmbedded = true |
| Forall o In rtitem.EmbeddedObjects |
| If ( o.Type = EMBED_ATTACHMENT ) Then |
| Call agentlog.Logaction("Objectname:" + o.name) |
| End If |
| nextFile: |
| End Forall |
| Else |
| Call agentLog.LogAction("Kein Object enthalten.") |
| End If |
| End If |
| nextitem: |
| End ForAll |
| |
| ' nächter Versuch, wenn Attachment nicht am Richtext hängen |
| Dim vEval As Variant |
| Dim embObj As NotesEmbeddedObject |
| vEval = Evaluate("@AttachmentNames", doc) |
| Call agentLog.LogAction("check @AttachmentNames") |
| If IsArray(vEval) then |
| ForAll v In vEval |
| If v <> "" Then |
| If hasEmbedded And Not findEmbedded Then |
| Call agentLog.LogAction("Nicht bearbeitetes Attachment =" & v) |
| else |
| Call agentLog.LogAction("enthalten Attachment:" & v) |
| End If |
| Set embObj = doc.GetAttachment(v) |
| End If |
| End ForAll |
| Else |
| If vEval <> "" Then |
| If hasEmbedded And Not findEmbedded Then |
| Call agentLog.LogAction("Nicht bearbeitetes Attachment =" & vEval) |
| Else |
| Call agentLog.LogAction("enthalten Attachment:" & vEval) |
| End If |
| End If |
| End if |
| |
| ' Iterate through each of the document's items looking for attachments |
| Dim objAttachment As NotesEmbeddedObject |
| Dim icounter As Integer |
| icounter = 0 |
| Call agentlog.Logaction("Check item.type Attachment") |
| ForAll item In doc.Items |
| Call agentlog.Logaction(item.name + " itemTyp" + CStr(item.Type)) |
| |
| If item.Type = RFC822Text Then |
| Call agentlog.Logaction("RFC822Text.Name" + item.Values(0)) |
| |
| End If |
| If item.Type = Attachment Then |
| ' first in Values array is the name of the attachment. |
| Set objAttachment = doc.GetAttachment(item.Values(0)) |
| iCounter = iCounter + 1 |
| |
| 'get the attachment filename |
| Call agentlog.Logaction("objAttachment.Name" + CStr(icounter)+" " + objAttachment.Name) |
| End If |
| End forall |
| |
| ' %REM MIME Verarbeitung |
| ' Dim s As New NotesSession |
| Dim mime As NotesMimeEntity |
| Dim parent As NotesMimeEntity |
| Dim stream As NotesStream |
| Dim header As NotesMIMEHeader |
| Dim filename As String |
| Dim basedir As String |
| basedir = "c:\temp\" |
| Set stream = session.CreateStream |
| |
| Set mime = doc.GetMIMEEntity |
| |
| if Not mime Is Nothing Then |
| Call agentLog.LogAction("is mime") |
| else |
| Call agentLog.LogAction("is NOT mime") |
| End If |
| |
| While Not mime Is Nothing |
| |
| 'if a mime part contains an attachment the Content-Disposition header will contain the value of "attachment" |
| |
| Set header = mime.GetNthHeader("Content-Disposition") |
| If (Not header Is Nothing) Then |
| Call agentLog.LogAction("Has header") |
| 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 baseDir + filename, "binary" |
| mime.GetContentAsBytes stream, True |
| stream.Close |
| End If |
| else |
| Call agentLog.LogAction("header Is Nothing") |
| End If |
| |
| Set mime = mime.GetNextEntity(SEARCH_DEPTH) |
| Wend |
| |
| |
| session.ConvertMime = True |
| |
| ' %END REM |
| |
| |
| weiter: |
| Set doc = dc.getnextdocument(doc) |
| 'Stop |
| Wend |
| |
| Ende: |
| If fehler > 0 then |
| Messagebox "Shrink Images mit Fehlern beendet. Errorcount=" + CStr(fehler) + Chr(13) + "Siehe auch Logmail" |
| Call agentlog.Logaction("Generate Shrink Images ended. Errorcount=" + CStr(fehler)) |
| else |
| Messagebox "Shrink Images ohne Fehler beendet." + Chr(13) + "Siehe auch Logmail" |
| Call agentlog.Logaction( "Generate Shrink Images successfully ended") |
| End if |
| Call agentLog.LogAction("Finish...") |
| Call agentlog.close |
| |
| Exit Sub |
| fehler: |
| fehler = fehler +1 |
| Print "ShrinkImages ERROR:" + Str(Err) + " " + Error$(ERR) + " in Zeile " + CStr(Erl) |
| Call agentlog.Logaction( "ShrinkImages ERROR:" + Str(Err) + " " + Error$(ERR) + " in Zeile " + CStr(Erl) ) |
| Err = 0 |
| Goto weiter |
| |
| End Sub |
Thema: iPhone Mail mit Inlines, Inlines sichtbar, aber programmatisch nicht (Gelesen 8366 mal)