Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Bilder innerhalb der PST nach dem Empfang verkleinern

Frage Microsoft Outlook & Mail

Mitglied: Zunaras

Zunaras (Level 1) - Jetzt verbinden

27.11.2013, aktualisiert 12:05 Uhr, 1806 Aufrufe, 17 Kommentare, 1 Danke

Schönen guten Tag,

meine Frage bezieht sich auf Outlook 2010.
Es gibt ja so Leute, die ihre Bilder in Originalgröße, z.B. vom Handy, per eMail verschicken. Eine Mail hat dann schon mal 10 MB statt 200 KB.

Kennt jemand von euch eine Möglichkeit, durch ein Tool oder durch VBA diese Bilder auf Knopfdruck nachträglich zu verkleinern? Entweder einzeln oder mehrere in einem Rutsch? Das eMail-Datum sollte davon unberührt bleiben.

Viele Grüße
Zunaras
Mitglied: SlainteMhath
27.11.2013 um 11:10 Uhr
Moin,

schau dir mal IrvanView an.

lg,
Slainte
Bitte warten ..
Mitglied: Zunaras
27.11.2013 um 11:40 Uhr
Hallo,

vielleicht habe ich es nicht genau genug beschrieben.

Ich meine die Bilder innerhalb der PST. Die, die sich als Anhang in den Nachrichten befinden.

Ich spinne jetzt mal ein wenig rum: die Mail müsste sicherlich exportiert werden, dessen Bilder in einen Ordner verschieben, diese dann auf z.B. auf 1024 dpi reduziert werden, diese wieder in die ausgelagerte Mail zurück verschieben und die ganze Mail dann mit den kleineren Bildern in Outlook an den Ursprungsort importiert werden.

Viele Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
28.11.2013, aktualisiert um 00:21 Uhr
Hallo Zunaras,
ich glaube hiermit habe in dir schon vor einiger Zeit eine Steilvorlage geliefert welche mit ein wenig Anpassung deinem Wunsch gerecht wäre...

Grüße Uwe
Bitte warten ..
Mitglied: Zunaras
28.11.2013 um 09:05 Uhr
Hallo colinardo,

das wäre ja schön, wenn man das verwenden könnte.
Wichtig wäre, das man auch alte Nachrichten damit bearbeiten kann ohne die Zeitstempel zu verändern.
Leider recht mein Wissen nicht um das entsprechend anzupassen...

Viele Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
28.11.2013 um 09:06 Uhr
ohne Moos im Moment nix los ...
Bitte warten ..
Mitglied: colinardo
28.11.2013, aktualisiert um 17:31 Uhr
Wichtig wäre, das man auch alte Nachrichten damit bearbeiten kann ohne die Zeitstempel zu verändern.
geht nicht

Folgenden Code in dein Projekt einfügen / die globalen Variablen sollten am Anfang des Projektes stehen:
(Hinweis für andere die hier vorbei schauen: der Code funktioniert nur in Zusammenhang mit dieser benutzerdefinierten COM-Bibliothek)
01.
Dim WithEvents m_objMailItem As MailItem 
02.
Dim WithEvents m_objExpl As Explorer 
03.
Dim m_IsMailFolder As Boolean 
04.
  
05.
Private Sub m_objExpl_Close() 
06.
    If Application.Explorers.Count > 0 Then 
07.
        Set m_objExpl = Application.ActiveExplorer 
08.
    Else 
09.
        Set m_objExpl = Nothing 
10.
        Set m_objMailItem = Nothing 
11.
    End If 
12.
End Sub 
13.
  
14.
Private Sub m_objExpl_FolderSwitch() 
15.
    Dim objFolder As MAPIFolder 
16.
    Set objFolder = m_objExpl.CurrentFolder 
17.
    If objFolder.DefaultItemType = olMailItem Then 
18.
        m_IsMailFolder = True 
19.
    Else 
20.
        m_IsMailFolder = False 
21.
    End If 
22.
    Set objFolder = Nothing 
23.
End Sub 
24.
  
25.
Private Sub m_objExpl_SelectionChange() 
26.
    If m_IsMailFolder Then 
27.
        Dim objItem As Object 
28.
        Dim objAction As Outlook.Action 
29.
        If m_objExpl.Selection.Count > 0 Then 
30.
            Set objItem = m_objExpl.Selection(1) 
31.
            If objItem.Class = olMail Then 
32.
                Set m_objMailItem = objItem 
33.
                If m_objMailItem.Attachments.Count > 0 Then 
34.
                    Set objAction = m_objMailItem.Actions("Bilder verkleinern") 
35.
                    If objAction Is Nothing Then 
36.
                        Set objAction = m_objMailItem.Actions.Add 
37.
                        With objAction 
38.
                            .Enabled = True 
39.
                            .Name = "Bilder verkleinern" 
40.
                            .ShowOn = olMenu 
41.
                        End With 
42.
                        m_objMailItem.Save 
43.
                    End If 
44.
                End If 
45.
            End If 
46.
        End If 
47.
        Set objItem = Nothing 
48.
        Set objAction = Nothing 
49.
    End If 
50.
End Sub 
51.
 
52.
Private Sub m_objMailItem_CustomAction(ByVal Action As Object, ByVal Response As Object, Cancel As Boolean) 
53.
    Cancel = True 
54.
    Select Case Action.Name 
55.
        Case "Bilder verkleinern" 
56.
            resizeMailImages m_objMailItem 
57.
    End Select 
58.
End Sub 
59.
 
60.
Sub resizeMailImages(Item As MailItem) 
61.
    Dim objMail As MailItem, Att As Attachment, arrFiles() As String, tempfolder As String, imgOrigTempFolder As String, imgResizedTempFolder As String, counter As Integer 
62.
    Set fso = CreateObject("Scripting.FilesystemObject") 
63.
    Set regex = CreateObject("vbscript.regexp") 
64.
    regex.IgnoreCase = True 
65.
    regex.Global = True 
66.
    Set objMail = Item 
67.
    tempfolder = Environ("Temp") 
68.
    imgOrigTempFolder = tempfolder & "\img_orig"        'temp folder for original attachments 
69.
    imgResizedTempFolder = tempfolder & "\img_res"      'temp folder for resized attachments 
70.
    counter = 0     'counter for arrDel() Array 
71.
    If objMail.Attachments.Count > 0 Then               'if there are attachments ... 
72.
        'valid extensions for image resizing 
73.
        arrValidExt = Array("jpg", "jpeg", "png", "bmp", "gif", "tiff", "tif") 
74.
     
75.
        For Each Att In objMail.Attachments 
76.
            strExt = LCase(fso.GetExtensionName(Att.FileName))  'get extension of attachment 
77.
            For i = 0 To UBound(arrValidExt) 
78.
                If strExt = arrValidExt(i) Then         'if extension ist valid to be resized 
79.
                    'check if attachment is normal attachment not inline 
80.
                    patternFix = Replace(Att.FileName, ".", "\.", , , vbTextCompare) 
81.
                    patternFix = Replace(patternFix, "[", "\[", , , vbTextCompare) 
82.
                    patternFix = Replace(patternFix, "]", "\]", , , vbTextCompare) 
83.
                    patternFix = Replace(patternFix, "^", "\^", , , vbTextCompare) 
84.
                    patternFix = Replace(patternFix, "$", "\$", , , vbTextCompare) 
85.
                    patternFix = Replace(patternFix, "+", "\+", , , vbTextCompare) 
86.
                    patternFix = Replace(patternFix, "(", "\(", , , vbTextCompare) 
87.
                    patternFix = Replace(patternFix, ")", "\)", , , vbTextCompare) 
88.
                    regex.pattern = "<img [^>]*src=""[^""]*(" & patternFix & ")[^""]*""" 
89.
                    Set myMatches = regex.Execute(objMail.HTMLBody) 
90.
                    If myMatches.Count = 0 Then     'attachment ist normal attachment not inline 
91.
                        ReDim Preserve arrFiles(counter) 
92.
                        arrFiles(counter) = Att.FileName 
93.
                        counter = counter + 1 
94.
                        Exit For 
95.
                    End If 
96.
                End If 
97.
            Next 
98.
        Next 
99.
         
100.
        If counter > 0 Then 
101.
            'check if folders exist 
102.
            If Not fso.FolderExists(imgOrigTempFolder) Then 
103.
                MkDir (imgOrigTempFolder) 
104.
            End If 
105.
            If Not fso.FolderExists(imgResizedTempFolder) Then 
106.
                MkDir (imgResizedTempFolder) 
107.
            Else 
108.
                If fso.GetFolder(imgResizedTempFolder).Files.Count > 0 Then 
109.
                    fso.GetFolder(imgResizedTempFolder).Delete (True) 
110.
                End If 
111.
                MkDir (imgResizedTempFolder) 
112.
            End If 
113.
             
114.
            'Resize Images 
115.
            Set imageResizer = CreateObject("ImageresizerCom.ImageResizerCom") 
116.
            For i = 0 To UBound(arrFiles) 
117.
                'assemble Paths to images in filesystem 
118.
                imgOrigPath = imgOrigTempFolder & "\" & fso.GetBaseName(arrFiles(i)) & "_" & tobase36(CLng((Now() - #1/1/1970#) * 86400)) & "." & LCase(fso.GetExtensionName(arrFiles(i))) 
119.
                imgResizedPath = imgResizedTempFolder & "\" & arrFiles(i) 
120.
                'save attachment in message to filesystem 
121.
                objMail.Attachments(arrFiles(i)).SaveAsFile (imgOrigPath) 
122.
                'Resize Image with custom function library 
123.
                imageResizer.ResizeImage imgOrigPath, imgResizedPath, 500 
124.
            Next 
125.
            Set imageResizer = Nothing 
126.
             'Delete the original Attachments from message 
127.
            For i = 0 To UBound(arrFiles) 
128.
                objMail.Attachments(arrFiles(i)).Delete 
129.
            Next 
130.
            're-add resized images as attachments 
131.
            For Each file In fso.GetFolder(imgResizedTempFolder).Files 
132.
                objMail.Attachments.Add file.Path 
133.
            Next 
134.
            'delete folder with resized images 
135.
            fso.GetFolder(imgResizedTempFolder).Delete (True) 
136.
            'Speichere Mail 
137.
            objMail.Save 
138.
        End If 
139.
     
140.
    End If 
141.
    Set fso = Nothing 
142.
    Set regex = Nothing 
143.
End Sub
Dann noch im Application_Startup-Event diese Zeile hinzufügen:
01.
Private Sub Application_Startup() 
02.
  '... 
03.
  Set m_objExpl = Application.ActiveExplorer 
04.
End Sub
Die Seitenlänge (in Pixel) die die Bilder bekommen sollen kannst du im letzten Parameter in Zeile 123 des Scriptes festlegen.

Wichtig: danach Outlook neu starten !

Jetzt kannst du bei Mails die mindestens ein Bild-Attachment besitzen, mit einem Rechtsklick auf die Mail die Aktion aufrufen:

2530cef5905ef2840255cc9dc455aac4 - Klicke auf das Bild, um es zu vergrößern

Grüße Uwe
p.s. jetzt wäre mal eine Spende(via Paypal) für den "armen" Coder angebracht !! > ist angekommen ...Bedankt !!
Bitte warten ..
Mitglied: Zunaras
28.11.2013 um 14:17 Uhr
Hallo colinardo,

das letzte habe ich nicht verstanden. Was ist der "Application_Startup-Event" ?

Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
28.11.2013 um 14:22 Uhr
Zitat von Zunaras:
das letzte habe ich nicht verstanden. Was ist der "Application_Startup-Event" ?
Dieses Event sollte schon in deinem VBA-Projekt vorhanden sein, wenn du mein erstes Makro zum Bilder verkleinern noch nutzt:
nach der Zeile:
Private Sub Application_Startup()
fügst du zusätzlich noch diese ein:
  Set m_objExpl = Application.ActiveExplorer
Bitte warten ..
Mitglied: Zunaras
28.11.2013 um 15:08 Uhr
Natürlich nutze ich das Makro noch!

Habs gefunden und hinzugefügt.

Läuft prima!

Hier habe ich noch herausgefunden, das man eine andere Bildgröße einstellen kann

imageResizer.ResizeImage imgOrigPath, imgResizedPath, 1024

Und jetzt lässt Du Dir alles patentieren!

Viele Grüße und besten Dank!
Zunaras
Bitte warten ..
Mitglied: Zunaras
07.08.2014 um 09:59 Uhr
Hallo colinardo,

evtl. kannst Du mir noch mal helfen.

Wenn ich mit Rechtsklick -> Bilder verkleinern oder beim weiterleiten -> verkleinern möchte,
kommt der Laufzeitfehler 75, Fehler beim Zugriff auf Pfad/Datei.
Bei Zeile 14 im Codeschnipsel bleibt er hängen.


Die letzte Änderung, die ich in Outlook gemacht habe:
GoogleCalendarSync deinstaliert, gSync installiert

Ich habe noch versucht Dein Assembly neu zu installieren. Es kommt aber nur die Abfrage ob es deinstalliert werden soll. Nach OK wird es erfolgreich bestätigt. Das kann ich beliebig oft wiederholen.
Wenn ich die Festplatte durchsuche, finde ich die Datei noch unter:
C:\Windows\System32 und C:\Windows\SysWOW64


01.
02.
03.
If counter > 0 Then 
04.
            'check if folders exist 
05.
            If Not fso.FolderExists(imgOrigTempFolder) Then 
06.
                MkDir (imgOrigTempFolder) 
07.
            End If 
08.
            If Not fso.FolderExists(imgResizedTempFolder) Then 
09.
                MkDir (imgResizedTempFolder) 
10.
            Else 
11.
                If fso.GetFolder(imgResizedTempFolder).Files.Count > 0 Then 
12.
                    fso.GetFolder(imgResizedTempFolder).Delete (True) 
13.
                End If 
14.
                MkDir (imgResizedTempFolder) 
15.
            End If 
16.
             
17.
            'Resize Images 
18.
            Set imageResizer = CreateObject("ImageresizerCom.ImageResizerCom") 
19.
            For i = 0 To UBound(arrFiles) 
20.
                'assemble Paths to images in filesystem 
21.
                imgOrigPath = imgOrigTempFolder & "\" & fso.GetBaseName(arrFiles(i)) & "_" & tobase36(CLng((Now() - #1/1/1970#) * 86400)) & "." & LCase(fso.GetExtensionName(arrFiles(i))) 
22.
                imgResizedPath = imgResizedTempFolder & "\" & arrFiles(i) 
23.
                'save attachment in message to filesystem 
24.
                objMail.Attachments(arrFiles(i)).SaveAsFile (imgOrigPath) 
25.
                'Resize Image with custom function library 
26.
                imageResizer.ResizeImage imgOrigPath, imgResizedPath, 1600 
27.
            Next 
28.
            Set imageResizer = Nothing 
29.
             'Delete the original Attachments from message 
30.
            For i = 0 To UBound(arrFiles) 
31.
                objMail.Attachments(arrFiles(i)).Delete 
32.
            Next 
33.
34.
.

Viele Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
07.08.2014, aktualisiert um 10:19 Uhr
Wenn ich mit Rechtsklick -> Bilder verkleinern oder beim weiterleiten -> verkleinern möchte,
kommt der Laufzeitfehler 75, Fehler beim Zugriff auf Pfad/Datei.
Bei Zeile 14 im Codeschnipsel bleibt er hängen.
abmelden und die temporären Dateien und Ordner in %temp% löschen ...

Grüße Uwe
Bitte warten ..
Mitglied: Zunaras
07.08.2014 um 10:52 Uhr
Hallo,

Temp-Ordner ist jetzt leer.

Jetzt kommt Laufzeitfehler -2147221005 (800401f3)
Fehler beim Ausführen der Operation

Jetzt bleibt er bei Zeile 18 stehen.

Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
07.08.2014 um 10:54 Uhr
Zitat von Zunaras:
Jetzt kommt Laufzeitfehler -2147221005 (800401f3)
Fehler beim Ausführen der Operation

Jetzt bleibt er bei Zeile 18 stehen.
das ist mir klar, du hast ja die COM-Library deinstalliert !!!
Bitte warten ..
Mitglied: Zunaras
07.08.2014 um 11:40 Uhr
Die ImageResizerAssembly.exe will immer nur deinstallieren.
Ich habe die dll und tlb jetzt manuell gelöscht und die ImageResizerAssembly.exe ausgeführt. Er hat nun installiert und registriert.

Hab den PC dann neu gestartet. Wie oben, blieb er in Zeile 14 hängen.

Dann bin ich noch mal in den Temp-Ordner und hab die wiedervorhandenen img_orig und img_res gelöscht.

Scheint jetzt geholfen zuhaben.

Viele Grüße
Zunaras
Bitte warten ..
Mitglied: colinardo
07.08.2014, aktualisiert um 11:49 Uhr
Dann bin ich noch mal in den Temp-Ordner und hab die wiedervorhandenen img_orig und img_res gelöscht.
Das Problem ist hier manchmal das Outlook die Bilder im Hintergrund noch im Zugriff hat und sich deshalb der Ordner nicht löschen lässt. Das habe ich hier mit einer Löschroutine beim Start von Outlook gelöst:
01.
Private Sub Application_Startup() 
02.
    On Error Resume Next 
03.
    Set fso = CreateObject("Scripting.FilesystemObject") 
04.
    tempfolder = Environ("Temp") 
05.
    imgOrigTempFolder = tempfolder & "\img_orig" 
06.
    imgResizedTempFolder = tempfolder & "\img_res" 
07.
    If fso.FolderExists(imgOrigTempFolder) Then 
08.
        fso.GetFolder(imgOrigTempFolder).Delete 
09.
    End If 
10.
    If fso.FolderExists(imgResizedTempFolder) Then 
11.
        fso.GetFolder(imgResizedTempFolder).Delete 
12.
    End If 
13.
 
14.
    Set m_objExpl = Application.ActiveExplorer 
15.
    Set fso = Nothing 
16.
End Sub
Bitte warten ..
Mitglied: Zunaras
07.08.2014 um 12:08 Uhr
Hab den Code übernommen. Danke vielmals!

Viele Grüße
Zunaras
Bitte warten ..
Mitglied: Zunaras
16.12.2014, aktualisiert 17.12.2014
Hallo colinardo,

vielleicht kannst Du Dir das noch mal ansehen?

Laufzeitfehler '430':
Klasse unterstützt keine Automatisierung oder unterstützt erwartete Schnittstelle nicht.

Der Fehler kommt hin und wieder, wenn ich eine oder mehrere Nachrichten mit der Maus in einen anderen Ordner ziehe zum verschieben.
In Zeile 8 bleibt er dann hängen.
Mir kommt es so vor, wenn ich nach dem Markieren etwas warte und dann verschiebe, dann klappt es ohne Probleme.


01.
Private Sub m_objExpl_SelectionChange() 
02.
    If m_IsMailFolder Then 
03.
        Dim objItem As Object 
04.
        Dim objAction As Outlook.Action 
05.
        If m_objExpl.Selection.Count > 0 Then 
06.
            Set objItem = m_objExpl.Selection(1) 
07.
            If objItem.Class = olMail Then 
08.
                Set m_objMailItem = objItem 
09.
                If m_objMailItem.Attachments.Count > 0 Then 
10.
                    Set objAction = m_objMailItem.Actions("Bilder verkleinern") 
11.
                    If objAction Is Nothing Then 
12.
                        Set objAction = m_objMailItem.Actions.Add 
13.
                        With objAction 
14.
                            .Enabled = True 
15.
                            .Name = "Bilder verkleinern" 
16.
                            .ShowOn = olMenu 
17.
                        End With 
18.
                        m_objMailItem.Save 
19.
                    End If 
20.
                End If 
21.
            End If 
22.
        End If 
23.
        Set objItem = Nothing 
24.
        Set objAction = Nothing 
25.
    End If 
26.
End Sub
Viele Grüße
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Grafik
gelöst Suche Programm um Bilder zu verkleinern (10)

Frage von fox14ch zum Thema Grafik ...

Outlook & Mail
Outlook 2016 - Briefpapier Bilder werden nicht angezeigt (6)

Frage von Markowitsch zum Thema Outlook & Mail ...

Exchange Server
EDB Postfach in PST Exportieren (33)

Frage von Herbrich19 zum Thema Exchange Server ...

Hyper-V
gelöst Hyper V VM verkleinern (2)

Frage von bytetix zum Thema Hyper-V ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...