HTML-Formatierung beim Export

Friend Sub MailEmpfangen()
 
10:     Dim acc As New MailAccount
20:     Dim strSubject As String
30:     Dim intFirst As Int16
40:     Dim intLast As Int16
50:     Dim varTicketNr As VariantType
60:     Dim strFiles As String = vbNullString
70:     Dim strFilename As String = vbNullString
80:     Dim strDirectory As String = vbNullString
90:     Dim strFullFileName As String = vbNullString
100:    Dim blAtt As Boolean
110:    Dim blTID As Boolean
120:    Dim strTicket As String = vbNullString
130:    Dim strFROM As String = vbNullString
140:    Dim strCC As String = vbNullString
 
150:    Start.StatusText.Text = "Postfach wird gelesen..."
 
160:    Try
170:        With acc
180:            .Host = "HostIP"
190:            .DatabaseFilename = "mailG\itsupport.nsf"
200:            If CBool(CType(Start.TableLayoutPanel1.Controls("txtOption1_1"), TextBox).Text) = True Then
210:                .Password = "xxxxxx"
220:            Else
230:                .Password = ""
240:            End If
250:        End With
 
            'Alle Mails auflisten
260:        Dim lstMails As NotesMailCollection = NotesTools.GetMails(acc, True)
 
270:        For Each itm As NotesMail In lstMails
280:            strSubject = itm.Subject
290:            intFirst = CShort(InStr(strSubject, "#"))
300:            intLast = CShort(InStrRev(strSubject, "#"))
310:            strFROM = Replace(Replace(itm.From, "CN=", ""), "/O=CompanyName", "", , , CompareMethod.Text)
320:            strCC = Replace(Replace(itm.CC, "CN=", ""), "/O=CompanyName", "", , , CompareMethod.Text)
 
                'Anhänge auslesen
330:            For Each att As Domino.NotesEmbeddedObject In itm.AttachmentFilenames
340:                Start.StatusText.Text = "Attachments werden gelesen..."
350:                strFilename = att.Name.ToString
360:                strDirectory = "\\ServerIP\Daten\Programme\Support\Public\Ablage\MailIn"
370:                strFullFileName = strDirectory & "\" & Now.ToFileTime & "_" & strFilename
380:                strFiles = strFullFileName & "|" & strFiles
390:                att.ExtractFile(strFullFileName)
400:                blAtt = True
410:            Next
420:            If blAtt = True Then
430:                strFiles = Mid(strFiles, 1, Len(strFiles) - 1)
440:            Else
450:                strFiles = vbNullString
460:            End If
 
                'Entscheidung ob mit oder ohen Ticket-ID
470:            If intFirst > 0 And intLast > 0 And (intLast > intFirst) Then
480:                varTicketNr = CType(Mid(strSubject, intFirst + 1, intLast - intFirst - 1), VariantType)
490:                If IsNumeric(varTicketNr) Then
                        'mit Ticketnummer
500:                    blTID = True
510:                    Start.StatusText.Text = "Tabelle 'tbl_Ticket_Mail' wird geschrieben..."
520:                    Start.Tbl_TICKET_MAILTableAdapter1.Insert(varTicketNr, strSubject, strFROM, strCC, itm.Body, strFiles, True, Now(), True)
530:                    strTicket = "Ja"
540:                End If
550:            Else
                    'ohne Ticketnummer
560:                blTID = False
570:                varTicketNr = 0
580:                Start.StatusText.Text = "Tabelle 'tbl_Mail' wird geschrieben..."
590:                Start.Tbl_MAILTableAdapter1.Insert(varTicketNr, strSubject, strFROM, strCC, itm.Body, strFiles, True, Now())
600:                strTicket = "Nein"
610:            End If
 
620:            Start.ListBox1.Items.Insert(0, Now() & " Mail empfangen, von: " & strFROM & " - Ticket: " & strTicket & " Nr: " & varTicketNr.ToString & " - Betreff: " & strSubject & " - mit Anhang: " & blAtt)
630:            blAtt = False
640:            strFiles = vbNullString
650:        Next
 
660:    Catch ex As Exception
670:        SetText("FEHLER Zeile: " & Err.Erl.ToString & " - " & ex.Message & " - " & ex.Data.ToString)
 
680:    Finally
690:        Start.StatusText.Text = "Bereit..."
700:        acc = Nothing
710:    End Try
 
    End Sub

Private Shared Function _GetMails(ByVal aMailAccount As MailAccount, ByVal MoveMails As Boolean) As NotesMailCollection
 
    ' Die Session starten
    Dim Session As New Domino.NotesSession
    Session.Initialize(aMailAccount.Password)
    ' Datenbank öffnen
    Dim MailDB As Domino.NotesDatabase
    Dim MailServer As String = Session.GetEnvironmentString("MailServer", True)
    ' Dim DatabaseFilename As String = Session.GetEnvironmentString("MailFile", True)
 
    MailDB = Session.GetDatabase(MailServer, aMailAccount.DatabaseFilename)
 
    If Not MailDB.IsOpen Then
        MailDB.Open()
    End If
 
    Dim result As New NotesMailCollection
    Dim rtITEM As NotesRichTextItem
 
    Dim n_View As Domino.NotesView
    Dim n_ViewNav As Domino.NotesViewNavigator
    Dim n_ViewEntry As Domino.NotesViewEntry
    Dim n_Document As Domino.NotesDocument
 
    n_View = MailDB.GetView("($Inbox)")
    n_ViewNav = n_View.CreateViewNav
    n_ViewEntry = n_ViewNav.GetFirstDocument
 
    ' For all mails
    Do While Not (n_ViewEntry Is Nothing)
 
        n_Document = n_ViewEntry.Document
        Dim oAttachment As Domino.NotesEmbeddedObject
 
        rtITEM = CType(n_Document.GetFirstItem("Body"), NotesRichTextItem)
        ' Add data to our object
        Dim nm As New NotesMail
 
        With nm
            '.Body = n_Document.GetItemValue("Body")(0).ToString
            .Body = rtITEM.GetFormattedText(True, 0) ' n_Document.GetItemValue("Body")(0).ToString
            .Subject = n_Document.GetItemValue("Subject")(0).ToString
            .From = n_Document.GetItemValue("From")(0).ToString
        End With
 
        If n_Document.HasEmbedded Then
            Dim fileNames As Object() = CType(Session.Evaluate("@AttachmentNames", n_Document), Object())
            For Each fileName As String In fileNames
                oAttachment = n_Document.GetAttachment(fileName)
                nm.AttachmentFilenames.Add(oAttachment)
            Next
        End If
 
        ' Add object to our list
        result.Add(nm)
 
        ' Remove from list
        If MoveMails Then
            n_Document.PutInFolder("erledigt")
            n_Document.RemoveFromFolder("($Inbox)")
        End If
 
        ' Next Mail
        n_ViewEntry = n_ViewNav.GetNextDocument(n_ViewEntry)
    Loop
 
    Return result
 
End Function

...
   Dim nDoc as NotesDocument
   Dim nTempDoc as NotesDocument
   ...
   rtItem=nDoc.getFirstItem("Body")
   nTempDoc=MailDB.CreateDocument
   nTempDoc.CreateRichtextItem("Body")
   rtItem.CopyItemToDocument(nTempDoc,"Body")


   ...
   mime=nTempDoc.GetMIMEEntity
   xBody=mime.ContentAsText

With nm
    mime = n_Document.GetMIMEEntity
    If Not mime Is Nothing Then
        mime.DecodeContent()
        .Body = mime.ContentAsText
    Else
        .Body = "<div style='font-family: Calibri, Tahoma, Arial; font-size: 12px;'>" & HttpUtility.HtmlEncode(n_Document.GetItemValue("Body")(0).ToString).Replace(ControlChars.NewLine, "<br />") & "</div>"
    End If
    .Subject = n_Document.GetItemValue("Subject")(0).ToString
    .From = n_Document.GetItemValue("From")(0).ToString
End With