martenk
Goto Top

VBA - suche in Variablen

Hallo Gemeinschaft

ich lese mit diesem Script eine outlook mail aus
Sub ExtractMailInfo()
    Dim fMails As Object, mail As Object, txtContent As String, arrLines As Variant, objExcel As Object, wb As Object, sheet As Object, rngStart As Object, rngCurrent As Object, objOL As Object, fErledigt As Object, txtStatus As String, txtTime As String, txtMessage As String, txtMachine As String, txtSN As String, txtIP As String, txtLocation As String, txtCountTotal As String, txtCountColor As String

    ' Outlook Object erzeugen  
    Set objOL = CreateObject("Outlook.Application")  
    
     Const EXCELFILE = "c:\PrinterAlerts.xlsx"  
    
    'Ordner in Outlook referenzieren  
  '  Set fMails = Application.Session.Stores("test@test.eu").GetRootFolder.Folders("Druckalerts")  
    
    'Ordner in Outlook referenzieren  
    Set fMails = objOL.Session.Stores.Item("test@test.eu").GetRootFolder.Folders.Item("Druckalerts")  
    'Unterordner referenzieren in den die Mails verschoben werden wenn sie bearbeitet wurden  
  '  Set fErledigt = fMails.Folders("erledigt")  
    
    
    If fMails.Items.Count > 0 Then

        'Workbook setzen  
        Set wb = ActiveWorkbook
        
        'Daten kommen in erstes Worksheet  
        Set sheet = wb.Worksheets(1)
        
        'Startzelle in Spalte A ermitteln  
        Set rngStart = sheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Set rngCurrent = rngStart
        
        While fMails.Items.Count > 0
            
            'aktuelle Mail  
            Set mail = fMails.Items(1)
            
            'Body extrahieren  
            txtContent = mail.Body
            
            ' Zeilen in ein Array schreiben  
            arrLines = Split(txtContent, vbNewLine, -1, vbTextCompare)
            
            ' Zeilen den Variablen zuweisen  
z1 = arrLines(1)
z2 = arrLines(2)
z3 = arrLines(3)
z4 = arrLines(4)
z5 = arrLines(5)
z6 = arrLines(6)
z7 = arrLines(7)
z8 = arrLines(8)
z9 = arrLines(9)
z10 = arrLines(10)
z11 = arrLines(11)
z12 = arrLines(12)
z13 = arrLines(13)
z14 = arrLines(14)
z15 = arrLines(15)
z16 = arrLines(16)
z17 = arrLines(17)
z18 = arrLines(18)
z19 = arrLines(19)
z20 = arrLines(20)
z21 = arrLines(21)
z22 = arrLines(22)
z23 = arrLines(23)
z24 = arrLines(24)
z25 = arrLines(25)
z26 = arrLines(26)
......... geht bis 200

nun folgendes Problem - die Mails ändern sich zum Teil bei den Längen einzelner Zeilen

so sieht eine mail aus

hier steht unterschiedlich langer Text

dann...

Buchungsnummer: rerer454rr4
Buchungsdatum: 20.03.2023 / 21:50

Objektnummer: 4343411
Objektnummer Vermieterbereich: 43434
Objektname Webseite: Freistehendes Ferienhaus (eingezäunt) mit eigenem Grundstück dir. test K 5
Ihre Kennung: K 5

Buchungszeitraum: 01.04.2023 - 08.04.2023
Kundenname: Test Peter
Anzahl der Personen: 5

Haustier: 1
1. Größe: 30-60cm Hund


Buchungszusatz:

nun müsste ich wissen, in welchen arrays

Buchungsnummer
Ihre Kennung
Buchungszeitraum
Kundenname
Anzahl der Personen
Haustier
Buchungszusatz ob überhaupt vorhanden

Content-ID: 6515099651

Url: https://administrator.de/contentid/6515099651

Ausgedruckt am: 22.11.2024 um 06:11 Uhr

6247018886
6247018886 26.03.2023 aktualisiert um 14:12:32 Uhr
Goto Top
Nimm Regular Expressions , dann bist du nicht auf Zeilen angewiesen
EMail auslesen, verschieben und mit Excel ausgelesene Daten weiterverarbeiten
martenk
martenk 26.03.2023 aktualisiert um 14:19:13 Uhr
Goto Top
verstehe nicht, wie ich es bei mir anwenden kann - ich brauche ja nur die entsprechenden werte

also z.b. K5 bei Kennung usw
6247018886
6247018886 26.03.2023 aktualisiert um 14:33:25 Uhr
Goto Top
Zitat von @martenk:

verstehe nicht, wie ich es bei mir anwenden kann - ich brauche ja nur die entsprechenden werte

also z.b. K5 bei Kennung usw

Dann erteilen wir dir eine Lektion in Regex fürs Wochenende

https://danielfett.de/2006/03/20/regulaere-ausdruecke-tutorial/

Set regex = CreateObject("vbscript.regexp")  
regex.Global = False: regex.IgnoreCase = True: regex.MultiLine = False
regex.Pattern = "Ihre Kennung:\s*([^\r\n]*)"  
set matches = regex.Execute(txtContent)
if matches.count > 0 then
   strKennung = Trim(matches(0).submatches(0))
   Msgbox strKennung
End if
martenk
martenk 26.03.2023 um 14:41:59 Uhr
Goto Top
ah okay - und wenn ich alle Begriffe haben möchte, in einem Durchlauf - wie würdet ihr es da machen
6247018886
6247018886 26.03.2023 aktualisiert um 14:49:04 Uhr
Goto Top
Array mit einer Liste von den vorangehenden Texten definieren und dann das Regex in die Schleife packen in der man über das Array itteriert, Suchbegriff im Regex dann durch Schleifen variable ersetzen.

Schöne Hausaufgabe für dich 😉, wir wollen dir den Spass ja nicht verderben..
martenk
martenk 26.03.2023 um 16:47:25 Uhr
Goto Top
okay - hat geklappt

nun noch eine Frage - es kommt dann in der email eine Tabelle im body

da klappt das leider nicht so - wie komme ich an den betrag


Preise

Mietpreis
01.04.2023 - 08.04.2023 588,00 EUR

Reisepreis
588,00 EUR
6247018886
6247018886 26.03.2023 aktualisiert um 17:39:11 Uhr
Goto Top
HTML Quelltext der Mail raus ziehen
txtContent = mail.HTMLBody
und Regex an die Tabelle anpassen fertig.
martenk
martenk 26.03.2023 um 17:47:50 Uhr
Goto Top
das klappt leider überhaupt nicht
6247018886
6247018886 26.03.2023 aktualisiert um 17:53:42 Uhr
Goto Top
Doch auch das klappt, musst den Regex halt an den Quelltext Anpassen da HTML ja aus Tags besteht und Tabellenzeilen mit <tr></tr> und Spalten mit <td></td> etc. ausgezeichnet sind. Bisschen anstrengenmusst du dich halt schon etwas. So denn ich bin dann raus.

Cheers
martenk
martenk 26.03.2023 um 18:07:28 Uhr
Goto Top
ich weiss nicht, wie ich an die letzte spalte kommen soll

in der ersten spalte in der ersten zeile steht der Begriff Mietpreis

in der Zeile darunter in der letzten Spalte der Betrag

keine Ahnung wie du das meinst
martenk
martenk 27.03.2023 um 08:03:14 Uhr
Goto Top
Könnt ihr mir bitte noch einmal helfen - ich weiß nicht, wie ich an diese Position kommen soll
martenk
martenk 27.03.2023 um 09:28:00 Uhr
Goto Top
so sieht der email body aus - ich benötige die 588 Euro - könnt ihr dabei bitte helfen

<br><br><br><br>Kundensprache: Deutsch </span><o:p></o:p></p><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0><tr style='height:11.25pt'><td style='padding:0cm 0cm 0cm 0cm;height:11.25pt'></td></tr></table></td><td width=28 valign=top style='width:21.0pt;background:white;padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='color:black'><img border=0 width=20 height=10 style='width:.2083in;height:.1041in' id="_x0000_i1052" src="https://test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td><td style='padding:0cm 7.5pt 0cm 0cm'><p class=MsoNormal><!--[if gte vml 1]><v:shapetype id="_x0000_t75" coordsize="21600,21600" o:spt="75" o:preferrelative="t" path="m@4@5l@4@11@9@11@9@5xe" filled="f" stroked="f"> 

<v:stroke joinstyle="miter" /> 

<v:formulas>

<v:f eqn="if lineDrawn pixelLineWidth 0" /> 

<v:f eqn="sum @0 1 0" /> 

<v:f eqn="sum 0 0 @1" /> 

<v:f eqn="prod @2 1 2" /> 

<v:f eqn="prod @3 21600 pixelWidth" /> 

<v:f eqn="prod @3 21600 pixelHeight" /> 

<v:f eqn="sum @0 0 1" /> 

<v:f eqn="prod @6 1 2" /> 

<v:f eqn="prod @7 21600 pixelWidth" /> 

<v:f eqn="sum @8 21600 0" /> 

<v:f eqn="prod @7 21600 pixelHeight" /> 

<v:f eqn="sum @10 21600 0" /> 

</v:formulas>

<v:path o:extrusionok="f" gradientshapeok="t" o:connecttype="rect" /> 

<o:lock v:ext="edit" aspectratio="t" /> 

</v:shapetype><v:shape id="_x0000_s1026" type="#_x0000_t75" alt="Klicken Sie hier, um sich Ihr Objekt nochmal anzuschauen." href="https://www.e-test.de/index.cfm?fuseaction=objekt.showObject&amp;onr=76478&amp;utm_medium=email&amp;utm_source=mailservice-kommunikation&amp;utm_content=buchungen" target="&quot;_blank&quot;" style='position:absolute;margin-left:347.6pt;margin-top:0;width:225pt;height:150pt;z-index:251658240;mso-wrap-edited:f;mso-width-percent:0;mso-height-percent:0;mso-wrap-distance-left:0;mso-wrap-distance-top:0;mso-wrap-distance-right:0;mso-wrap-distance-bottom:0;mso-position-horizontal:right;mso-position-horizontal-relative:text;mso-position-vertical-relative:line;mso-width-percent:0;mso-height-percent:0' o:allowoverlap="f" o:button="t"> 

<v:fill o:detectmouseclick="t" /> 

<v:imagedata src="https://cdn.e-test.de/photos/9d398c8e0b4778b70871366d8b0cdf43_725x450.webp" /> 

<w:wrap type="square"/> 

</v:shape><![endif]--><![if !vml]><a href="https://www.test.de/index.cfm?fuseaction=objekt.showObject&amp;onr=76478&amp;utm_medium=email&amp;utm_source=mailservice-kommunikation&amp;utm_content=buchungen" target="&quot;_blank&quot;"><img border=0 width=300 height=200 style='width:3.125in;height:2.0833in' src="https://cdn.test.de/photos/9d398c8e0b4778b70871366d8b0cdf43_725x450.webp" align=right alt="Klicken Sie hier, um sich Ihr Objekt nochmal anzuschauen." v:shapes="_x0000_s1026"></a><![endif]><o:p></o:p></p></td></tr></table></td><td width=20 valign=top style='width:15.0pt;padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='color:black'><img border=0 width=20 height=15 style='width:.2083in;height:.1562in' id="_x0000_i1053" src="https://cdn.test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td><td width=1 style='width:.75pt;background:#CCCCCC;padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='color:black'><img border=0 width=1 height=15 style='width:.0104in;height:.1562in' id="_x0000_i1054" src="https://cdn.test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td></tr></table></div><p class=MsoNormal><span style='display:none'><o:p>&nbsp;</o:p></span></p><div align=center><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 width=0 style='width:474.0pt;background:white'><tr style='height:.75pt'><td width=632 style='width:474.0pt;background:#CCCCCC;padding:0cm 0cm 0cm 0cm;height:.75pt'><p class=MsoNormal><span style='color:black'><img border=0 id="_x0000_i1055" src="https://cdn.test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td></tr></table></div><p class=MsoNormal><span style='display:none'><o:p>&nbsp;</o:p></span></p><div align=center><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 width=0 style='width:474.0pt;background:white'><tr><td width=1 style='width:.75pt;background:#CCCCCC;padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='color:black'><img border=0 width=1 height=15 style='width:.0104in;height:.1562in' id="_x0000_i1056" src="https://cdn.test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td><td width=20 valign=top style='width:15.0pt;padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='color:black'><img border=0 width=20 height=10 style='width:.2083in;height:.1041in' id="_x0000_i1057" src="https://cdn.test.de/gfx/mail/s.gif"></span><o:p></o:p></p></td><td width=590 valign=top style='width:442.5pt;padding:0cm 0cm 0cm 0cm'><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 width="100%" style='width:100.0%'><tr><td style='padding:0cm 0cm 0cm 0cm'><p class=MsoNormal><span style='font-size:12.0pt;font-family:"Arial",sans-serif;color:#006699'><br>Preise<br><br></span><span style='font-size:10.5pt;font-family:"Arial",sans-serif;color:#006699'>Mietpreis </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0><tr style='height:15.0pt'><td width=180 style='width:135.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 3.75pt;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>01.04.2023 - 08.04.2023 </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td><td width=300 style='width:225.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 0cm;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;color:black'>&nbsp; </span><span style='font-size:9.0pt'><o:p></o:p></span></p></td><td width=100 style='width:75.0pt;background:#F2F2F2;padding:0cm 3.75pt 0cm 0cm;height:15.0pt'><p class=MsoNormal align=right style='text-align:right'><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>588,00 EUR </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td></tr></table><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><br></span><span style='font-size:10.5pt;font-family:"Arial",sans-serif;color:#006699'>Reisepreis </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0><tr style='height:15.0pt'><td width=180 style='width:135.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 3.75pt;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>&nbsp; </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td><td width=300 style='width:225.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 0cm;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>&nbsp; </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td><td width=100 style='width:75.0pt;background:#F2F2F2;padding:0cm 3.75pt 0cm 0cm;height:15.0pt'><p class=MsoNormal align=right style='text-align:right'><strong><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>588,00 EUR</span></strong><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'> </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td></tr></table><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><br></span><span style='font-size:10.5pt;font-family:"Arial",sans-serif;color:#006699'>Abzug test (10,0%) </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0><tr style='height:15.0pt'><td width=180 style='width:135.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 3.75pt;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>&nbsp; </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td><td width=300 style='width:225.0pt;background:#F2F2F2;padding:0cm 0cm 0cm 0cm;height:15.0pt'><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>&nbsp; </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td><td width=100 style='width:75.0pt;background:#F2F2F2;padding:0cm 3.75pt 0cm 0cm;height:15.0pt'><p class=MsoNormal align=right style='text-align:right'><span style='font-size:9.0pt;font-family:"Arial",sans-serif;color:black'>- 58,80 EUR </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p></td></tr></table><p class=MsoNormal><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><br></span><span style='font-size:10.5pt;font-family:"Arial",sans-serif;color:#006699'>Ihre Mietgutschrift brutto </span><span style='font-size:9.0pt;font-family:"Arial",sans-serif'><o:p></o:p></span></p><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0><tr style='height:15.0pt'><td width=180  
SomebodyToLove
SomebodyToLove 27.03.2023 um 11:01:06 Uhr
Goto Top
Hallo,

ich meine der Regex sollte in etwa so aussehen:

(\d.+\d+)(?:\s(?:EUR?|€))

Hier eine Erklärung dazu:
/
(\d.+\d+)(?:\s(?:EUR?|€))
/
gm
1st Capturing Group (\d.+\d+)
\d matches a digit (equivalent to [0-9])
. matches any character (except for line terminators)
+ matches the previous token between one and unlimited times, as many times as possible, giving back as needed (greedy)
\d matches a digit (equivalent to [0-9])
+ matches the previous token between one and unlimited times, as many times as possible, giving back as needed (greedy)
Non-capturing group (?:\s(?:EUR?|€))
\s matches any whitespace character (equivalent to [\r\n\t\f\v ])
Non-capturing group (?:EUR?|€)
1st Alternative EUR?
EU matches the characters EU literally (case sensitive)
R matches the character R with index 8210 (5216 or 1228) literally (case sensitive)
? matches the previous token between zero and one times, as many times as possible, giving back as needed (greedy)
2nd Alternative €
€ matches the character € with index 836410 (20AC16 or 202548) literally (case sensitive)
Global pattern flags 
g modifier: global. All matches (don't return after first match)  
m modifier: multi line. Causes ^ and $ to match the begin/end of each line (not only begin/end of string)

Ich habe es auf folgender Seite getestet:
https://regex101.com/

Hoffe es hilft dir face-smile

Beste Grüße
Somebody
martenk
martenk 27.03.2023 um 16:37:18 Uhr
Goto Top
klappt leider nicht
SomebodyToLove
Lösung SomebodyToLove 28.03.2023 um 08:58:21 Uhr
Goto Top
Hallo martenk,

ich habe den Regex jetzt noch einmal umgebaut:

([\d,\.]+[\.,]\d\d) (EURO|Euro|EUR|€)

Also auf der Seite funktioniert er und er gibt mir auch die Beträge aus deinem HTML Beispiel aus.

Schau mal ob er so bei dir funktioniert, falls du nicht eh schon eine anderen Lösung gefunden hast.

Grüße
Somebody
martenk
martenk 28.03.2023 um 13:33:50 Uhr
Goto Top
Hi - das klappt nun - weiss nur nicht, wie ich es in eine Variable bekomme, zumal in der Suche mehrere Euro Werte enthalten sind - ich benötige aber nur den ersten Wert
SomebodyToLove
Lösung SomebodyToLove 28.03.2023 um 15:35:39 Uhr
Goto Top
Hiho,

es gibt in VBA unter der Klasse den Parameter "Global" diesen kannst du auf False setzen.
Dann sollte er nur den ersten Wert verwenden.

Global:
Set to True if you want to match all of the cases that fit our pattern in the string (in which you’re attempting to find the pattern). Set to False to if you want only the first match to be found.
Quelle: https://software-solutions-online.com/vba-regex-guide/

Function RE6(strData As String) As String

    Dim RE As Object, REMatches As Object
    Set RE = CreateObject("vbscript.regexp")  
    With RE
        .MultiLine = False
        .Global = False
        .IgnoreCase = True
        .Pattern = "\[substep [a-zA-Z]\](.*?); {1}"  
    End With

    Set REMatches = RE.Execute(strData)

    RE6 = ""  


End Function

Grüße
Somebody
6247018886
Lösung 6247018886 28.03.2023 aktualisiert um 16:19:11 Uhr
Goto Top
Setzen wir dem Trauerspiel mal ein Ende
Set regex = CreateObject("vbscript.regexp")  
regex.Global = False: regex.IgnoreCase = True
regex.Pattern = "[\d\.]+(,\d{1,2})?(?=\s*(EURO?|€))"  
set matches = regex.Execute("Das ist ein Test 1.200,50 EUR Blablub 100,30€")  
If matches.Count > 0 Then
    betrag = matches(0)
    MsgBox betrag
Else
    MsgBox "No match.",vbExclamation  
End If

Fehlt dann nur noch
Wie kann ich einen Beitrag als gelöst markieren?
martenk
martenk 29.03.2023 um 08:36:37 Uhr
Goto Top
super klasse - lieben Dank - das ist ja eine geniale Funktion