Outlook Dateianhänge speichern/entfernen ohne Body-Bilder

Moderator: ModerationP

Outlook Dateianhänge speichern/entfernen ohne Body-Bilder

Beitragvon Soda10 » 13. Okt 2021, 10:10

Hallo Ihr VBA Cracks,
ich habe in meiner Lösung hier im Forum (http://www.office-loesung.de/p/viewtopic.php?f=165&t=870308) nun noch die Auswahlmöglichkeit geschaffen zwischen "Ganzer Mail Zippen" und "Nur Dateianhänge zippen".
Alles funktioniert soweit gut.
Ich habe aber das Problem, dass mir bei der Option "Nur Dateianhänge zippen" auch die Bilder (Name und Format ist variabel) im HtmlBody speichert und zippt und ebenfalls aus der aktiven Mail löscht.
Wie kann ich verhindern, dass er die Inhalte im Body nicht anfasst und einfach so belässt. In den Foren wurde ich nicht fündig. Vielleicht gebe ich ja auch die falschen Suchbegriffe ein.
Ich möchte, dass nur die Anhänge der geöffneten E-Mail gespeichert und aus der Email entfernt werden. Nichts vom Body. Leider fehlen dann der Mail die Bilder und man sieht nur noch die Platzhalter. Das Zippen und wiedereinfügen kommt dann nach den Punkten und funktioniert auch.
Hier mein VBA-Schnipsel:
Code: Alles auswählen
...
    ElseIf OptMailOrFile = 0 Then
        Dim objOL As Outlook.Application
        Dim objMsg As Outlook.MailItem
        Dim objAttachments As Outlook.Attachments
        Dim objSelection As Outlook.Selection
        Dim lngCount As Long
        Dim strFile As String
        Dim strFolderpath As String
        ' Outlook Application Objekt instanziieren
        Set objOL = CreateObject("Outlook.Application")
        ' Collection der ausgewählten Objekte (E-Mails) ermitteln
        Set objSelection = objOL.ActiveExplorer.Selection
        ' Ordner-Pfad festlegen, wo der E-Mail Anhang gespeichert werden soll
        ' Jedes ausgewählten Objekte (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
        ' dann unter dem Ordnerpfad speichern.
        For Each objMsg In objSelection
            ' Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                For i = lngCount To 1 Step -1
                    ' Speichert die Attachments bevor sie in der Mail gelöscht werden.
                    ' Dateinamen ermitteln
                    strFile = objAttachments.Item(i).FileName
                    ' Kombiniere Ablagepfad mit dem Dateinamen
                    strFile = strPath & "\" & strFile
                    ' Anhang als Datei speichern
                    objAttachments.Item(i).SaveAsFile strFile
                    ' Dateianhang löschen
                    objAttachments.Item(i).Delete
                Next i
            End If
        Next
...

Liebe Grüße Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon DerHoepp » 13. Okt 2021, 10:17

Hallo Dieter,

du müsstest den HTML-Quelltext analysieren und dort schauen, wo ein img-Tag enthalten ist. Dort liest du das src-Attribut aus und berücksichtigst den dort angegebenen Dateinamen bei der Schleife über die Attachments.

Viele Grüße
derHöpp
DerHoepp
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 9869
Registriert: 14. Mai 2013, 11:08

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 13. Okt 2021, 15:07

Hallo Höpp,
das war gar nicht so leicht herauszufinden wie ich In Outlook an den Quelltext bei neuen Mails herankomme.
Nun ging es doch. Outlook benennt die Bilder in image001.jpg oder *.png bzw. *.gif usw. je nachdem welche Ursprungsquelle.
Der zugehörige Tag sieht zb. so aus:
<img width=701 height=395 id="Grafik_x0020_2" src="cid:image002.jpg@01D7C038.FEE374E0">
oder so
<img width=201 height=67 id="Bild_x0020_1" src="cid:image006.png@01D7C038.FEE374E0" alt="Logo_klein">
Wobei die Reihenfolge wie sie benannt werden wohl so ist:
1. die Bilder im Body werden durchnummeriert beginnend mit image001.* (z.B. image001.jpg, image002.gif, image003.png) usw. ich lasse es mal bei den drei Bildern im Text als Beispiel für Nr. 3
2. Es werden die Anlagen weitergezählt aber nicht umbenannt (z.B. tabelle.xls, Video.mp4) ich belasse es mal als Beispiel bei diesen zwei Anhängen
3. Es werden die Bilder der Signatur weitergzählt also bei zwei Anlagen und drei Bildern im Body (ohne Signatur) wird das erste Bild in der Signatur z.B. image006.gif und das zweite in der Signatur zu image 007.png usw.
Die Endungen erhalten die Bilder immer vom Ursprung und sind somit variabel und nicht vorhersehbar.
hmm... Ich sehe grad, ich gebe mir selbst die Antwort. Ich kann ja über "strgFile" den Namen checken. Sobald die Datei 7 Zeichen links von der Endung "image" heißt, dann soll er diese Anlage nicht berücksichtigen :badgrin:
ok der Code lautet für alle Interessierten so:
Code: Alles auswählen
    ElseIf OptMailOrFile = 0 Then
        Dim objOL As Outlook.Application
        Dim objMsg As Outlook.MailItem
        Dim objAttachments As Outlook.Attachments
        Dim objSelection As Outlook.Selection
        Dim lngCount As Long
        Dim strFile, strTest As String
        Set objOL = CreateObject("Outlook.Application")
        Set objSelection = objOL.ActiveExplorer.Selection
        ' Jedes ausgewählte Objekt (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
        ' dann unter dem Ordnerpfad speichern.
        For Each objMsg In objSelection
            ' Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                For i = lngCount To 1 Step -1
                    ' Save attachment bevor sie in der Mail gelöscht werden.
                    ' Dateinamen ermitteln
                    strFile = objAttachments.Item(i).FileName
                    strTest = Left(strFile, Len(strFile) - 7)
                    If strTest = "image" Then GoTo endNext ' Prüfung ob es sich um ein Datei aus dem Body handelt und wenn ja keine Berücksichtigung!
                    strFile = strPath & "\" & strFile
                    objAttachments.Item(i).SaveAsFile strFile
                    ' Dateianhang löschen
                    objAttachments.Item(i).Delete
endNext:
                Next i
            End If
        Next

Eleganter und weniger Fehleranfällig waäre es natürlich wenn man irgendwo die Eigenschaft als Anlage des Bodys rauslesen könnte. Ich weiß aber nicht wo das ist.
Ich hoffe ich stoße nicht noch auf einen Fehler.
LG Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 13. Okt 2021, 15:49

Falls also jemand eine elegantere Lösung hat, her damit :D
LG Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon HKindler » 14. Okt 2021, 08:06

Hi,

bei deiner Lösung hast du ein Problem sobald jemand einen Anhang mit Namen "image123.gif" verwendet. Sinnvoller wäre es den HTML-Body der Nachricht per RegEx zu durchsuchen. Der Ausdruck könnte z.B. <img[^>]*?src="cid:(image\d{3}\.\w{3})@ lauten. Damit hättest du in der ersten Gruppe den Dateinamen stehen.
Gruß,
Helmut

----------------------------
Windows 10 Enterprise (64 Bit) / Office 365 ProPlus (32 Bit)
Benutzeravatar
HKindler
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6473
Registriert: 04. Jul 2013, 09:02
Wohnort: Schwarzwald

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 15. Okt 2021, 12:39

Hallo HKindler,
Danke für den Tip mit RegEx. Es ist sicher richtig, den Body der Mail nach den Images durchzusuchen und die Images aufzulisten. Ich kannte regex bisher nicht. Die Funktion erscheint mir sehr vielversprechend.
Ich habe mal zum Testen folgendes SUB geschrieben:
Code: Alles auswählen
Public Sub Reg_Exp_Test()
    Dim objRegEx As Object, objmatch As Object
    Dim strText As String
    Dim lngIndex As Long
    strText = "<img width=701 height=395 id=""Grafik_x0020_2"" src=""cid:image001.jpg@01D7C038.FEE374E0"">" & vbNewLine & "<img width=701 height=395 id=""Grafik_x0020_2"" src=""cid:image002.jpg@01D7C038.FEE374E0"">"
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "<img[^>]*?src=""cid:(image\d{3}\.\w{3})@"
        Set objmatch = .Execute(strText)
    End With
    For lngIndex = 0 To objmatch.Count - 1
        Debug.Print objmatch.Item(lngIndex).Value
    Next
    Set objRegEx = Nothing
    Set objmatch = Nothing
End Sub


Damit bekomme ich alle IMG-SRC aufgelistet. Sieht dann so: aus:

<img width=701 height=395 id="Grafik_x0020_2" src="cid:image001.jpg@
<img width=701 height=395 id="Grafik_x0020_2" src="cid:image002.jpg@

Jetzt habe ich folgende Frage
1. Wie bekomme das Script dazu, nur die Phrase "Image001.jpg" und "image002.jpg" auszugeben. Also alles zwischen dem ":" und dem "@". Es könnte ja auch mal länger sein, wer weiß.
LG Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon knobbi38 » 15. Okt 2021, 13:48

Hallo Dieter,

das müßte bei dem Pattern in einem SubMatch eines Match Objekts enthalten sein. Schau dir mal das im Debugger und in der Doku an.

Gruß Ulrich
knobbi38
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3605
Registriert: 02. Jul 2015, 14:23

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon DerHoepp » 15. Okt 2021, 13:49

Moin,

Ich finde deinen Elan und deine Vorgehensweise des selbstausprobierens sehr vorbildlich!. Was du suchst, sind die Submatches, die gefüllt werden, wenn im Pattern Klammerpaare vorhanden sind:
Code: Alles auswählen
Debug.Print objmatch.Item(lngIndex).SubMatches(0)


Viele Grüße
derHöpp
DerHoepp
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 9869
Registriert: 14. Mai 2013, 11:08

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 15. Okt 2021, 16:33

Hallo Ihr zwei,
Cool, vielen Dank hat super geklappt. das Submatches war es :roll:
Hätte ich auch selbst drauf kommen können.
Kann das ergebnis des Submatches jetzt perfekt in einer If then Abrage stecken und so die gefundenen Bilder auslassen. Eine Frage noch. funktioniert der Code auch wenn die Bilder im Body mal anderst heißen? weil nach meinem Verständnis müsste nach dem "cid:" auf jeden Fall "image" gefolgt von 3 Zahlen einem "." und gefolgt von 3 Zeichen (Dateierweiterung) heißen, oder? Das wären dann immer 8 Zeichen Plus Dateierweiterung. Ich meine es sollte so funktionieren. Ich konnte noch keine Mail Generieren die von der Namenskonvention "image" & <3 Ziffern> & "." & <3 Zeichen> abweicht. Aber sicher ist sicher...
Wie müsste der Pattern string lauten wenn ich bis zu 255 Zeichen plus Dateiendung zwischen abfragen will? Wäre der String dann wie folgt: "<img[^>]*?src=""cid:(\w{1,255}\.\w{3})@". Zumindest das Ergebnis ändert sich dadurch nicht.
mein jetztige Code (schon um die HTML Abfrage ergänzt).
Code: Alles auswählen
Public Sub Reg_Exp_Test()
    Dim obj, objInspector As Object
    Dim objRegEx As Object, objmatch As Object
    Dim strText As String
    Dim lngIndex As Long
    Dim olApp As Object
    Dim olMail
    If TypeOf Application.ActiveWindow Is Outlook.Explorer Then 'Outlook Item (Mail) ansprechen
        Set obj = Application.ActiveWindow
        Set obj = obj.Selection(1)
        Else
         Set objInspector = ActiveInspector
         objInspector.Activate
            If objInspector.IsWordMail Then
               Set obj = Application.ActiveInspector.CurrentItem
            End If
    End If
    'Ab hier Prüfung der Body Eigenschaft
    strText = obj.HTMLBody ' "Auslesen des "Bodys" der E-Mail - Ersetze "HTMLBody" durch "Body" für nur Text; "RTFBody" für Ritch Text Format!
    'Debug.Print strText
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "<img[^>]*?src=""cid:(\w{1,255}\.\w{3})@"
        Set objmatch = .Execute(strText)
    End With
    For lngIndex = 0 To objmatch.Count - 1
        'Debug.Print objmatch.Item(lngIndex).Value 'gibt den INhalt von objectmatch wieder - also die ganzen Phrase "<img...@"
        Debug.Print objmatch.Item(lngIndex).SubMatches(0) ' Hier kann dann die If - Then Abfrage rein um die Images einzeln auszuschließen.
    Next
    Set objRegEx = Nothing
    Set objmatch = Nothing
End Sub

LG Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon DerHoepp » 15. Okt 2021, 20:31

Moin,

die Antwort ist ja. allerdings dürfte das Pattern:
"cid:(\w+\.\w{3})@"
schon ausreichen.

Viele Grüße
derHöpp

[Nachtrag: die Form einer Content-ID-URL ist in RFC2392 beschrieben: https://datatracker.ietf.org/doc/html/rfc2392 ]
DerHoepp
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 9869
Registriert: 14. Mai 2013, 11:08

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon knobbi38 » 16. Okt 2021, 12:23

Hallo,

dann könnte auch schon
"cid:([^@]*)"
als Pattern ausreichen.

Gruß Ulrich
knobbi38
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3605
Registriert: 02. Jul 2015, 14:23

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 18. Okt 2021, 10:20

Servus,
@DerHoepp
Stimmt, und damit würden auch Dateien mit mehreren Punkten und anderen Zeichen im Namen wie z.B. "2021.10.18_??-bla bla bla .gif" auch erkannt werden.
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon knobbi38 » 18. Okt 2021, 11:35

Hallo,

so ganz nebenbei: Dateinamen, wie z.B. "2021.10.18_??-bla bla bla .gif" sind auf jeden Fall zu vermeiden. Ersetze die Punkte im Datum durch ein anderes Trennzeichen, z.B. den Unterstrich.

Gruß Ulrich
knobbi38
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3605
Registriert: 02. Jul 2015, 14:23

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon Soda10 » 10. Nov 2021, 10:33

Hallo Ulrich,
so ganz nebenbei: Dateinamen, wie z.B. "2021.10.18_??-bla bla bla .gif" sind auf jeden Fall zu vermeiden. Ersetze die Punkte im Datum durch ein anderes Trennzeichen, z.B. den Unterstrich.

Da gebe ich dir vollkommen recht, allerdings sage das mal 220 Mitarbeitern ;-)
LG Dieter
Soda10
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 65
Registriert: 28. Mai 2015, 12:52

Re: Outlook Dateianhänge speichern/entfernen ohne Body-Bilde

Beitragvon knobbi38 » 10. Nov 2021, 12:18

Soda10 hat geschrieben: allerdings sage das mal 220 Mitarbeitern

Rundschreiben, Mail, Fortbildung? Das gilt ja auch für andere Bereiche.

"Aus gegebenen Anlass ..." :mrgreen:

Gruß Ulrich
knobbi38
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3605
Registriert: 02. Jul 2015, 14:23

Nächste

Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast

cron