Option Explicit
 
Sub neue_mail(sID As String)
  Dim mIt As Outlook.MailItem   ' 1)
  ' Weitere Deklaration - gehört nach oben in den Deklarationsteil
  Dim i As Long   ' findet die Anfangs-Position im Text
  Dim j As Long   ' findet die End-Position im Text
  Dim d As Date   ' Datum der Mail
  Dim w As String ' Wer spielt weiß
  Dim s As String ' wer spielt schwarz
  Dim e As String ' Ergebnis
  Dim h As String ' Hyperlink
  Dim p As Long   ' Meine Punkte nach dem Spiel
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Deklaration
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If NS Is Nothing Then GL.set_namespace    ' 2)
  Stmp = TypeName(NS.GetItemFromID(sID))
  If Stmp = "MailItem" Then
    Set mIt = NS.GetItemFromID(sID)     ' 3)
  Else
    MsgBox "Die neue Mail ist vom unerwarteten Typ " & vbLf & Stmp & vbLf & _
      " und kann mit dem existierenden Makro nicht verarbeitet werden.", _
      vbCritical, "Abbruch"
    Exit Sub
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 1 - Die Mail ist identifiziert
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  If mIt.SenderName <> "jepi@gmx.net" Then Exit Sub
  i = InStr(mIt.Body, vbCrLf & vbCrLf & "Sehr geehrter ")
  If i = 0 Then Exit Sub
 
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  i = i + Len(vbCrLf & vbCrLf & "Sie haben  ")
  ' i - Das ist jetzt die Position rechts von "Sie haben jetzt "
 
  j = InStr(i, mIt.Body, " Punkte")
  ' Der Text zwischen den Positionen i und j enthält jetzt
  ' die Punktzahl
  ' MsgBox ">" & Mid(mIt.Body, i, j - i) & "<"
  ' nun wird dieser Text in eine Zahl vom Typ Long in
  ' Variable p gespeichert
 
  p = CLng(Mid(mIt.Body, i, j - i))
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 2 - Die Mail hat den gesuchten Inhalt
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  d = mIt.CreationTime
  i = InStr(mIt.Body, "Sicherung ") + 1 ' hinter Spielbrett
  i = InStr(i, mIt.Body, Chr(34)) + 1    ' steht die Paarung in
  j = InStr(i, mIt.Body, Chr(34))        ' Gänsefüßchen chr(34)="
  Stmp = Mid(mIt.Body, i, j - i)
 
  ' "Split" teilt den String am zweiten Argument, hier "-"
  w = Split(Stmp, "-")(0)
 
  ' In unserem Fall ergibt Split zwei Teile
  s = Split(Stmp, "-")(1)
 
  i = InStr(mIt.Body, "HYPERLINK ") + Len("HYPERLINK ")
 
  i = InStr(i, mIt.Body, Chr(34)) + 1    ' steht die Paarung in
  j = InStr(i, mIt.Body, "Sicherung")
  j = InStr(i, mIt.Body, Chr(34))        ' Gänsefüßchen chr(34)="
  h = Mid(mIt.Body, i, j - i)
 
  If InStr(mIt.Body, "Erfolgreich") Then
    e = "OK"
  ElseIf InStr(mIt.Body, "Fehlerhaft") Then
    e = "Fehler"
  Else
    e = "Kein Mail"
  End If
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 3 - alle Werte, die nach Excel geschrieben
  ' werden müssen liegen jetzt in einzelnen Variablen vor.
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...
  ' ...
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 3 - alle Werte, die nach Excel geschrieben
  ' werden müssen liegen jetzt in einzelnen Variablen vor.
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  mIt.UnRead = False
  Stmp = ""
  For i = 1 To mIt.Parent.Folders.Count()
    If mIt.Parent.Folders(i).Name = "Erledigt" Then
      Stmp = "OK"
      Exit For
    End If
  Next i
  If Len(Stmp) = 0 Then mIt.Parent.Folders.Add "Erledigt"
  mIt.Move mIt.Parent.Folders("Erledigt")
  Set mIt = Nothing
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 4 - Mit der Mail sind wir fertig
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...