E-Mails nach Inhalten parsen

[eknori]

hier der Code für das dynamische parsen

Sub Click(Source As Button)
   Dim s As New NotesSession
   Dim db As NotesDatabase
   Dim col As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim rtItem As Variant
   Dim plaintext As Variant
   Dim retVal As String
   Dim key As String
   Dim pos As Integer
   Dim pos1 As Integer
   Dim ToRead As Integer
   Set db = s.CurrentDatabase
   Set col = db.UnprocessedDocuments
   Set doc = col.GetFirstDocument
   Set rtitem = doc.GetFirstItem( "Body" )
   If ( rtitem.Type = RICHTEXT ) Then
      plainText = rtitem.GetFormattedText( False, 0 )

   End If
   
   key = "Zahlungsart:"
   
   pos=Instr(1, plaintext, Key)
   pos1 = Instr(pos, plaintext, Chr(10))
   
   ToRead = pos1 - (pos + Len(key) + 1)
   retval = Trim(Mid(plaintext,pos + Len(key) + 1 ,ToRead))
   Msgbox retval
   
End Sub

[immanuel]

Hallo Ulrich

Vielen Dank! Ich werde es am Montag im Geschäft ausprobieren... Vielen Dank auf für alle Antworten!
Lieber Gruss und noch ein schönes altes Jahr

Greez
Manuel

[eknori]

hier dann noch schnell zum Jahresabschluss die letzte Version

Sub Click(Source As Button)
   Dim s As New NotesSession
   Dim db As NotesDatabase
   Dim col As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim rtItem As Variant
   Dim plaintext As String
   Dim retVal As String
   Dim StartKey  As String, EndKey As String
   Dim pos As Integer
   Dim pos1 As Integer
   Dim ToRead As Integer
   
   Set db = s.CurrentDatabase
   Set col = db.UnprocessedDocuments
   Set doc = col.GetFirstDocument
   Set rtitem = doc.GetFirstItem( "Body" )
   If ( rtitem.Type = RICHTEXT ) Then
      plainText = rtitem.GetFormattedText( False, 0 )
   End If
   
   'Startkey= "Währung:"
   'Endkey = Chr(10)
   
   Startkey= "Adresse:"
   Endkey = "***********************************************"
   
   Msgbox GetParseString (plaintext, Startkey, EndKey)
   
End Sub

Function GetParseString(ToParse As String, StartsWith As String, EndsWith As String) As String
   Dim i As Integer, j As Integer
   i=Instr(1, ToParse, StartsWith)
   j= Instr(i, ToParse, EndsWith)
   GetParseString = Trim(Mid(ToParse,i + Len(StartsWith) + 1 , j - (i + Len(StartsWith) + 1)))
End Function

[Tode]

@eknori: nicht schlecht der Code.
Mein Ansatz wäre zwar ein anderer, aber das ist ja immer Geschmackssache... 

Hier mein Senf zu dem Würstchen...

Sub Initialize
   Dim ses As New NotesSession
   Dim db As NotesDatabase
   Dim dc As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim body As NotesRichtextItem
   
   Dim plainText As String
   Dim valArr As Variant
   
   Dim TransaktionsID As String, summe As Double
   
   Set db = ses.CurrentDatabase
   Set dc = db.UnprocessedDocuments
   
   Set doc = dc.GetFirstDocument
   Set body = doc.GetFirstItem( "Body" )
   
   plainText = body.GetFormattedText( False , 0 )
'- ggf. chr 10 durch chr 13 ersetzen, so dass wir ein einheitliches Bild bekommen
   plainText = Replace( plaintext, Chr$( 10 ) , Chr$( 13 ) )
   valArr = Fulltrim( Split( plainText , Chr$( 13 ) ) )
   
'- dieses Array können wir nun nach den verschiedenen Werten durchparsen
   TransaktionsID = GetLineVal( valArr , "TransaktionsID: " , "" )
   Summe = GetLineVal( valArr , "Transaktionsbestätigung für Spendenbetrag: " , "" )
   
   
End Sub

Function GetLineVal( valArr As Variant , startText As String, cutText As String ) As Variant
'- startText: Der Text, nach dem gesucht wird, cutText: Ein Text, der gegebenenfalls am Ende der Wertes abgeschnitten wird
   Dim tmpVal As String
   Dim i As Integer, pos As Integer
   
   For i = 0 To Ubound( valArr )
      tmpVal = Strright( valArr( i ) , startText )
      If tmpVal <> "" Then
         If cutText <> "" Then
            tmpVal = Strleft( tmpVal , cutText )            
         End If
'- beim ersten gefundenen Wert wird abgebrochen         
         GetLineVal = tmpVal
         Exit Function
      End If
   Next
'- Der Wert wurde bis hier nicht gefunden: also ist er nicht vorhanden...   
   GetLineVal = ""
End Function

Gruß
Tode