Textstellen gezielt aus einem Gesamtstring selektieren und Variablen zuordnen

[Umbauwfb]

Eine Antwort-Email soll in der Protokoll-Datei (auf Access) variabel einem bestimmten Teilnehmer zugeordnet werden:

In der Sende-Email wird dem Betreff (Subject) der nachfolgende Key am Ende zugeordnet.
Zweck: wenn die Email beantwortet wird, kann sie über diesen Key in Outlook selektiert werden und korrekt in die Protokolltabelle (auf Access) geschrieben werden.
Der grundsätzliche Ablauf mit fest im Code eingetragenen Schlüsseln funktioniert.

Jetzt soll das Ganze variabel werden.
Dazu muss aus dem Gesamtstring des Betreff (Subject) der Key als Gesamtes selektiert werden und aus diesem die Untergruppen Zahlen1, Zahlen2, Zahlen3
Beispiel:
AW: Nachfolgend senden wir Ihnen die Unterlagen zur Bewerbung von Herrn Burkhardt (5/900/403)


Überblick zu den Variablen:
vBetreff as String
vBetreff = olMail.Subject

Zahlen1 as Integer  > wird zu TeilnehmerID
Zahlen2 as Integer....wird im Ablauf nicht benötigt, vielleicht beim Selektieren
Zahlen3 as Integer  > wird zu AdressdatenID
Key as string
Key = (Zahlen1/ Zahlen2/ Zahlen3)

Bei der Anwort-Email kann sich der Key an einer beliebigen Stelle im Betreff finden (sollte eigentlich immer am Ende stehen, aber ich will mich nicht darauf festlegen, weil der Email-Sender den Betreff manipulieren kann).

Leider habe ich keine Ahnung, wie ich die betreffenden Stellen ansprechen kann...

Vielen Dank für jede Unterstützung
Harry

Code [Auswählen] Erweitern

Private Sub olItems_ItemAdd(ByVal item As Object)

'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment

Dim dB As DAO.Database
Dim rs2 As DAO.Recordset
Set dB = DBEngine.OpenDatabase("D:\Workbooks\Workbook Bewerbung Datenbank\Bewerbungen\Unternehmen.accdb")

'Prüfen, ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
    Set olMail = item
   
   
                        'Die nachfolgende Prüfung ist noch wild...die werde ich als letztes in den Code einbringen:
                        'Prüfen, ob Mail verwendet werden soll
                                '    If InStr(olMail.Subject, "Test") <> 0 And _
                                '    olMail.SenderEmailAddress = "kaiweissmann@outlook.de" Then
                                   
                                '    If InStr(olMail.Subject, "(" & "*" & "/" & "*" & ")") <> 0 Then
                        'If InStr(olMail.Subject, "(900/402)") <> 0 Then
   
   
'Momentanes Thema: Key aus Betreff selektieren und daraus TeilnehmerID und AdressdatenID selektieren
   
    Dim vBetreff As String
    vBetreff = olMail.Subject
   
    Dim Key As String
    'Key = (Zahlen1/Zahlen2/Zahlen3) und muss aus vBetreff selektiert werden. Die Klammern und die / gehören zum Key
   
    'Zahlen1 Zahlen2 und Zahlen3 müssen aus Key selektiert werden
    Dim Zahlen1 As Integer
    Dim Zahlen2 As Integer 'Zahlen2 wird für den eigentlichen Ablauf nicht benötigt, vielleicht hilft es beim Selektieren
    Dim Zahlen3 As Integer
   
    Zahlen1 = muss selektiert werden...wie???
    Zahlen2 = muss selektiert werden...wie???
    Zahlen3 = muss selektiert werden...wie???
 
   
        Set rs2 = dB.OpenRecordset("SELECT * FROM ProtokollT WHERE False", dbOpenDynaset)
                                            'rs2 füllt die Protokolldatei. Ein leerer Datensatz wird geladen
                            With rs2
                                .AddNew
                                !Body = olMail.Body
                                    Debug.Print olMail.Body
                                !ProtokollTypID = 1
                                !AdressdatenID = Zahlen3
                                !To = olMail.To
                                !From = olMail.Sender
                                !Subject = olMail.Subject
                                !TeilnehmerID = Zahlen1
                                !DatumZeit = Now
                               
                                .Update
                                .Close
                            End With
    'End If
End If

'    Aufräumen
    Set rs2 = Nothing
    Set dB = Nothing

End Sub

[ebs17]

Eine Variabilität  kann man ziemlich überzeugend umsetzen, wenn man nach Mustern sucht, wie das über reguläre Ausdrücke umsetzbar ist: Codebeispiel - "Intelligente" Textanalyse

Code [Auswählen] Erweitern

5/900/403Hier könnte man das Suchmuster einstellen auf Ziffer(n) - Trennzeichen - Ziffern - Trennzeichen - Ziffern.

Dabei kann man die jeweilige Anzahl der Ziffern fest oder in möglichen Bereichen einstellen, auch die Trennzeichen und die äußere Stringeingrenzung variabel einstellen.

[Umbauwfb]

Vielen Dank für die Information Eberhard,

ich habe mir das Ganze angesehen...damit bin leider ich mit meinen 3 Monaten Access noch grenzenlos überfordert...
Ich verstehe in meiner jetzigen Phase die Gesamtsituation, wenn ich den praktisch angewandten Code sehe...
dann kann ich das Stück für Stück analysen...und Stück für Stück verstehen... diese globale Aussage ist einfach noch zu komplex für mich...

Danke trotzdem und einen schönen Sonntag
Harry

[ebs17]

noch grenzenlos überfordert...

Das geht vielen so, so bei erster Annäherung. RegEx kommt aus einer ganz anderen Programmierwelt (Perl & Co.), hat eine ganz andere Logik und in dieser Logik eine extreme Abstraktion, wo also extrem viele Aktionen, die bei einer anderen Umsetzung nötig wären, in einem Suchmuster zusammengefasst werden.

Für eine einfache Anwendung:
Übernimm den ersten Codeblock aus https://www.ms-office-forum.net/forum/showpost.php?p=1474906&postcount=9 in ein Standardmodul.

Dann kannst Du folgendes laufen lassen. Wenn man sieht, wie es funktioniert, macht es gleich mehr Spaß, sich damit zu beschäftigen.

Code [Auswählen] Erweitern

Sub aufruf_DoIt()
    DoIt "AW: Nachfolgend senden wir Ihnen die Unterlagen zur Bewerbung von Herrn Burkhardt (5/900/403)"
End Sub

Sub DoIt(ByVal AnyText As String)
    Dim oMC As Object
    Set oMC = RegExMatchCollection(AnyText, "(\d)/(\d{3})/(\d{3})")
    If oMC.Count > 0 Then
        Debug.Print "Element1: ", oMC(0).SubMatches(0)
        Debug.Print "Element2: ", oMC(0).SubMatches(1)
        Debug.Print "Element3: ", oMC(0).SubMatches(2)
    End If
End Sub
\d ... eine einzelne Ziffer
\d{3} ... drei Ziffern
Klammerung erzeugt hier Teilmuster, die man somit unmittelbar auswerten kann.

[Umbauwfb]

Hallo Eberhard,
vielen Dank erst einmal dass Du Dir die Mühe machst, mich in dieses Thema einzuführen!
Ich habe die Module installiert...und der Ablauf funktioniert!

Dann habe ich angefangen zu experimentieren. Ich weiss ja nicht, wieviel Ziffern die einzelnen Blöcke haben werden. Das sind IDs...
Ich habe festgestellt, dass

Set oMC = RegExMatchCollection(AnyText, "(\d{3})/(\d{3})/(\d{3})")  mit (999/888/777) > Treffer
Set oMC = RegExMatchCollection(AnyText, "(\d{3})/(\d{3})/(\d{3})")  mit (99/888/777) > kein Treffer

Das ist ja auch logisch.
Kann man dieses Problem lösen? (indem ein größerer Ziffernbereich angegeben wird und dann auch die kleineren Anzahlen Ziffern als Treffer gelten?)

Grüße aus Lüneburg
Harry

[ebs17]

Klar, RegEx sind mächtig.

\d{1, 5} ... sucht nach einer bis fünf Ziffern
\d+ ... sucht nach mindestens einer Ziffer

[Umbauwfb]

Wow...ich habe jetzt alles mit d+ angelegt...besser geht es ja gar nicht...
Wie einfach ein derart komplexer Ablauf an dieser Stelle plötzlich werden kann!

Jetzt brauche ich nur noch Hilfe bei den folgenden Stellen:
1. Wo und wie baue ich den Ablauf im vorhandenen Code ein (nachfolgend der aktuelle Stand)
2. Wie rufe ich die 3 Stellen ab

Code [Auswählen] Erweitern

Option Explicit

Private WithEvents olItems As Outlook.Items

'Vorab in Outlook Macro-Benutzung in Outlook Trustcenter aktivieren
'wird im Video ID1337 direkt am Anfang erklärt
'Verweis auf Access legen...im Video ab 14:00...(statt Excel > Access)

Private Sub Application_Startup()

'Variablen dimensionieren
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace

Dim dB As DAO.Database
Dim rs2 As DAO.Recordset

'Variablen initialisieren
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items

'Test
Debug.Print "Application_Startup wird ausgeführt"


End Sub

Private Sub olItems_ItemAdd(ByVal item As Object)

'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment

Dim dB As DAO.Database
Dim rs2 As DAO.Recordset
Set dB = DBEngine.OpenDatabase("D:\Workbooks\Workbook Bewerbung Datenbank\Bewerbungen\Unternehmen.accdb")

'Prüfen, ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
    Set olMail = item
   
   
                        'Die nachfolgende Prüfung ist noch wild...die werde ich als letztes in den Code einbringen:
                        'Prüfen, ob Mail verwendet werden soll
                                '    If InStr(olMail.Subject, "Test") <> 0 And _
                                '    olMail.SenderEmailAddress = "kaiweissmann@outlook.de" Then
                                   
                                '    If InStr(olMail.Subject, "(" & "*" & "/" & "*" & ")") <> 0 Then
                        'If InStr(olMail.Subject, "(900/402)") <> 0 Then
   
   
'Momentanes Thema: Key aus Betreff selektieren und daraus TeilnehmerID und AdressdatenID selektieren
   
'    Dim vBetreff As String
'    vBetreff = olMail.Subject
'
'    Dim Key As String
'    'Key = (Zahlen1/Zahlen2/Zahlen3) und muss aus vBetreff selektiert werden. Die Klammern und die / gehören zum Key
'
'    'Zahlen1 Zahlen2 und Zahlen3 müssen aus Key selektiert werden
'    Dim Zahlen1 As Integer
'    Dim Zahlen2 As Integer 'Zahlen2 wird für den eigentlichen Ablauf nicht benötigt, vielleicht hilft es beim Selektieren
'    Dim Zahlen3 As Integer
'
'    Zahlen1 = muss selektiert werden...wie???
'    Zahlen2 = muss selektiert werden...wie???
'    Zahlen3 = muss selektiert werden...wie???
 
   
        Set rs2 = dB.OpenRecordset("SELECT * FROM ProtokollT WHERE False", dbOpenDynaset)
                                            'rs2 füllt die Protokolldatei. Ein leerer Datensatz wird geladen
                            With rs2
                                .AddNew
                                !Body = olMail.Body
                                    Debug.Print olMail.Body
                                !ProtokollTypID = 1
                                !AdressdatenID = 403
                                !To = olMail.To
                                !From = olMail.Sender
                                !Subject = olMail.Subject
                                !TeilnehmerID = 5
                                !DatumZeit = Now
                               
                                .Update
                                .Close
                            End With
    'End If
End If

'    Aufräumen
    Set rs2 = Nothing
    Set dB = Nothing

End Sub

Vielen Dank für die bisherige Hilfe...das Modul begeistert mich inzwischen!
Harry

[ebs17]

Zu 1: Du kennst Deine Frage und Deinen Code?

'Momentanes Thema: Key aus Betreff selektieren und daraus TeilnehmerID und AdressdatenID selektieren

In jenem Moment, wo Du Zugriff auf den Subject-Inhalt der Mail  hast, kannst Du ihn analysieren.

Zu 2: Statt Debug-Ausgabe an irgendwas übergeben, was Deine Dokumentation vervollständigt ...

Code [Auswählen] Erweitern

rs.Fields("teilnehmerID") = oMC(0).SubMatches(0)
' ...Wo Du Deine ID's verewigen willst, solltest Du doch wissen.

[Umbauwfb]

Hallo Eberhard,
ich muss leider noch einmal nerven...

Ich komme über eine Stelle nicht weg...
Ich habe eine "Welt" in dem Standardmodul und eine 2.Welt in meinem bestehenden Code.

Es gelingt mir nicht, die Werte, die im Standardmodul ermittelt werden, meinen zugehörigen Stellen im Code zuzuweisen.

Wenn ich     !AdressdatenID = oMC(0).SubMatches(2) im Code schreibe, erhalte ich die Meldung
             "Sub oder Funktion nicht definiert"  das ist ja auch klar...ich weiß aber nicht, was ich machen muss....

Muss ich die ganzen Prozeduren aus dem Standardmodul jetzt irgendwie in meinen Code einfügen...
Oder muss ich im Standardmodul eine Tabelle mit den 3 Werten schreiben, auf die ich dann im Code zurückgreifen kann???

Da fehlt mir ganz einfach noch der Hintergrund...
Kannst du das bitte noch etwas deutlicher für mich formulieren..

Vielen Dank
Harry

[ebs17]

Die Prozedur DoIt und der Aufruf dazu sollen nicht ins Standardmodul. Diese zeigen nur eine mögliche Verwendung, die aber überall stattfinden kann.
Die Prozedur DoIt wäre zu zerpflücken und in Deine olItems_ItemAdd einzubauen, also ...

- ziemlich am Anfang das Objekt deklarieren (Objekt MatchCollection, das die Treffer der Suche aufnimmt)
- und dann irgendwann

Code [Auswählen] Erweitern

Set oMC = RegExMatchCollection(olMail.Subject, "(\d+)/(\d+)/(\d+)")
' SubMatches übergeben und verarbeiten

[Umbauwfb]

Hallo Eberhard,

kurze Zwischenmeldung: der Code läuft 

Vielen Dank erstmal
Harry

[Umbauwfb]

Hallo Eberhard,
kann ich eine zweite Selektion in diesen Ablauf einbauen...es würde immer nur eine der beiden zutreffen...bei der zweiten Selektion würden nur die beiden ersten Key-Gruppen verglichen werden.

Der Unterschied:
Im ersten Fall geht eine Email mit Bezug auf Teilnehmer + Firma raus (TeilnehmerID/Nummer/AdressdatenID)
Im zweiten Fall geht eine Email mit nur Bezug auf Teilnehmer raus (TeilnehmerID/Nummer)

Ist das machbar?

Grüße aus Lüneburg
Harry

[ebs17]

Da ist fallabhängig eine Menge möglich.
- In dem Codeblock gibt es auch eine Test-Methode.
- In einen Mustervergleich könnte man die weitere Umgebung einbeziehen, also jenes anschauen, was sonst noch so vorkommt.
- In der Klammer könnte man die Schrägstriche zählen.
- Mit etwas Geschick und verlässlich gleichbleibenden Texten könnte man auch ein Pattern entwickeln, das zwei und drei Nummern finden und ausgewertet bekommen kann.

Also: Es kommt darauf an.

[Umbauwfb]

Hallo Eberhard,
ich habe eine ganz einfache Lösung gefunden: Ich bleibe bei dem gleichen Ablauf, fülle aber im vorlaufenden Code den dritten key mit einer "0"...funktioniert!

Vielen Dank noch einmal für Deine Hilfe.
Harry

Nachfolgend noch der komplette Code, falls das Jemanden mal interessieren sollte:

Code [Auswählen] Erweitern

Option Explicit


'In ThisOutlookSession

Private WithEvents olItems As Outlook.Items

'Vorab in Outlook Macro-Benutzung in Outlook Trustcenter aktivieren
'wird im Video ID1337 direkt am Anfang erklärt
'Verweis auf Access legen...im Video ab 14:00...(statt Excel > Access)

Private Sub Application_Startup()

'Variablen dimensionieren
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace

Dim dB As DAO.Database
Dim rs2 As DAO.Recordset

'Variablen initialisieren
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items

'Test
Debug.Print "Application_Startup wird ausgeführt"


End Sub

Private Sub olItems_ItemAdd(ByVal item As Object)

'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment


'Dimensionierung Objekt MatchCollection, das die Treffer der Suche aufnimmt
Dim oMC As Object

Dim dB As DAO.Database
Dim rs2 As DAO.Recordset
Set dB = DBEngine.OpenDatabase("D:\Workbooks\Workbook Bewerbung Datenbank\Bewerbungen\Unternehmen.accdb")

'Prüfen, ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
    Set olMail = item
 
'    'Key-Blöcke dimensionieren
    Dim Zahlen1 As Integer
    Dim Zahlen2 As Integer
    Dim Zahlen3 As Integer

 
'Definition der Suche
Set oMC = RegExMatchCollection(olMail.Subject, "(\d+)/(\d+)/(\d+)")
        Zahlen1 = oMC(0).SubMatches(0)
        Zahlen2 = oMC(0).SubMatches(1)
        Zahlen3 = oMC(0).SubMatches(2)
       
        'Test
'        Debug.Print Zahlen1
'        Debug.Print Zahlen2
'        Debug.Print Zahlen3
   
        Set rs2 = dB.OpenRecordset("SELECT * FROM ProtokollT WHERE False", dbOpenDynaset)
                                            'rs2 füllt die Protokolldatei.
                                            'Ein leerer Datensatz wird geladen
                            With rs2
                                .AddNew
                                !Body = olMail.Body
                                    Debug.Print olMail.Body
                                !ProtokollTypID = 1
                                !AdressdatenID = Zahlen3
                                !To = olMail.To
                                !From = olMail.Sender
                                !Subject = olMail.Subject
                                !TeilnehmerID = Zahlen1
                                !DatumZeit = Now
                               
                                .Update
                                .Close
                            End With
    'End If
End If

'    Aufräumen
    Set rs2 = Nothing
    Set dB = Nothing

End Sub


'---------------------------------------------------------------------------------------

'Im Modul modTextSelect

Option Explicit

Private pRegEx As Object

Public Property Get oRegEx() As Object
   If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
   Set oRegEx = pRegEx
End Property

Public Function RegExTest(ByVal SourceText As String, _
      ByVal SearchPattern As String, _
      Optional ByVal bIgnoreCase As Boolean = True, _
      Optional ByVal bGlobal As Boolean = True, _
      Optional ByVal bMultiLine As Boolean = True) As Boolean
   
   With oRegEx
      .Pattern = SearchPattern
      .IgnoreCase = bIgnoreCase
      .Global = bGlobal
      .MultiLine = bMultiLine
      RegExTest = .Test(SourceText)
   End With
End Function

Public Function RegExReplace(ByVal SourceText As String, _
      ByVal SearchPattern As String, _
      ByVal ReplaceText As String, _
      Optional ByVal bIgnoreCase As Boolean = True, _
      Optional ByVal bGlobal As Boolean = True, _
      Optional ByVal bMultiLine As Boolean = True) As String
   
   With oRegEx
      .Pattern = SearchPattern
      .IgnoreCase = bIgnoreCase
      .Global = bGlobal
      .MultiLine = bMultiLine
      RegExReplace = .Replace(SourceText, ReplaceText)
   End With
End Function

Public Function RegExMatchCollection(ByVal SourceText As String, _
      ByVal SearchPattern As String, _
      Optional ByVal bIgnoreCase As Boolean = True, _
      Optional ByVal bGlobal As Boolean = True, _
      Optional ByVal bMultiLine As Boolean = True) As Object
   
   With oRegEx
      .Pattern = SearchPattern
      .IgnoreCase = bIgnoreCase
      .Global = bGlobal
      .MultiLine = bMultiLine
      Set RegExMatchCollection = .Execute(SourceText)
   End With
End Function