FREMDBEITRAG: Makros zum direkten Anzeigen von *.jpg in Outlook

Question

Folgender Beitrag wurde mir per Mail zugesendet, Fragen, Kommentare, Anregungen bitte in diesen Thread posten.
(Ich bin nur der arme Moderator, und habe mich zugegebenermaßen noch nicht so intensiv mit VB-OL Makros beschäftigt ;) )

Die Dateien können, inklusive der Binär-Datei Bilder.frx die hier nicht angegeben ist, hier runter geladen werden:


 [line]
Hallo Peter.
 
Hier also das Outlook-Makro, mit dem man direkt *.jpg angezeigt kriegt. Zugegebenermaßen noch ziemlich rudimentär. Normalerweise kommentiere ich meine software auch. Aber Du brauchst ja nur durchzusteppen. Und wenn es Verständnis-Schwierigkeiten gibt, kannst Du mich ja fragen. Im Moment ist auch noch etwas nervig, daß grundsätzlich jedes *,jpg angezeigt wird, nicht nur die expliziten Anlagen. Ich würde mich freuen, wenn ich in irgendeiner Form mitkriegen würde, falls jemand die Makros weiterentwickelt. Und wenn ich selber noch was daran ändere, schicke ich Dir das dann auch gerne.
 
Viele Grüße, Björn


[Editiert am 26/5/2005 von lastwebpage]

[Editiert am 26/5/2005 von lastwebpage]

lastwebpage · Answer

DieseOutlookSitzung.cls
[line] 

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "DieseOutlookSitzung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Dim O As New Klasse1

Private Sub Application_Startup()

Set O.Expl = Outlook.ActiveExplorer

End Sub

lastwebpage · Answer

Klasse1.cls
 [line] 
VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "Klasse1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public WithEvents OL As Outlook.Application
Attribute OL.VB_VarHelpID = -1
Public WithEvents OlFolders As Folders
Attribute OlFolders.VB_VarHelpID = -1
Public WithEvents OlMailItem As MailItem
Attribute OlMailItem.VB_VarHelpID = -1
Public WithEvents OlNS As NameSpace
Attribute OlNS.VB_VarHelpID = -1
Public WithEvents Expl As Explorer
Attribute Expl.VB_VarHelpID = -1
Public WithEvents Expls As Explorers
Attribute Expls.VB_VarHelpID = -1
Public WithEvents OlInsp As Inspector
Attribute OlInsp.VB_VarHelpID = -1
Public WithEvents OlInsps As Inspectors
Attribute OlInsps.VB_VarHelpID = -1
Public WithEvents InboxItems As Items
Attribute InboxItems.VB_VarHelpID = -1
Public WithEvents OlPane As OutlookBarPane
Attribute OlPane.VB_VarHelpID = -1

Private Sub Expl_SelectionChange()

Const C_Pause As Single = 1

Dim OlE As Outlook.Explorer
Dim OlS As Outlook.Selection
Dim OlA As Attachment
Dim n%, x%, y%, FileNummer%, Name$

Set OlE = Application.ActiveExplorer
Set OlS = OlE.Selection

FileNummer = 0

If (OlS.Count > 0) Then
 x = OlS.Item(1).Attachments.Count
 If x > 0 Then
 For y = 1 To x
 Set OlA = OlS.Item(1).Attachments.Item(y)
 If (LCase(Right$(OlA.FileName, 3)) = "jpg") Then
 FileNummer = FileNummer + 1
 OlA.SaveAsFile "c:\OutlookTemp\" & FileNummer & ".jpg"
 End If
 Next y
 End If
End If

 If (FileNummer > 0) Then
 Bilder.Show
 End If

End Sub

Private Sub OlMailItem_Open(Cancel As Boolean)

MsgBox "Huhu!"

End Sub

lastwebpage · Answer

Bilder.frm
[line]
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Bilder 
 Caption = "Bilder"
 ClientHeight = 7260
 ClientLeft = 8700
 ClientTop = 7170
 ClientWidth = 9930
 OleObjectBlob = "Bilder.frx":0000
End
Attribute VB_Name = "Bilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 NächstesBild
End Sub

Private Sub UserForm_Click()
' MsgBox "Left " & Bilder.Left
' MsgBox "Top " & Bilder.Top
 NächstesBild
End Sub

Private Sub UserForm_Deactivate()
 Unload Bilder
End Sub

Private Sub UserForm_Initialize()
 
' MsgBox Bilder.Left
' MsgBox Bilder.Top
 NächstesBild
End Sub

Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 
 Dim Nummer%
 Nummer = KeyAscii
 
 ' Bei ESC beenden, sonst blättern:
 If Nummer = 27 Then
 Unload Bilder
 Else
 NächstesBild
 End If
 
End Sub

Private Sub NächstesBild()
 Static ls_Riegel_B As Boolean
 Static Datei$

 If (ls_Riegel_B True) Then
 Datei = Dir("C:\OutlookTemp\*.jpg")
 ls_Riegel_B = True
 Else
 Datei = Dir
 End If
 
 If Datei "" Then
 Bilder.PictureSizeMode = fmPictureSizeModeClip
 Bilder.Picture = LoadPicture("C:\OutlookTemp\" & Datei)
' MsgBox "Höhe " & Bilder.Picture.Height
' MsgBox "Breite " & Bilder.Picture.Width
 If (Bilder.Picture.Width > Bilder.Width * 26.458) Or _
 (Bilder.Picture.Height > Bilder.Height * 26.458) Then
 Bilder.PictureSizeMode = fmPictureSizeModeZoom
 End If
 Else
 Unload Bilder
 End If
 
End Sub

Private Sub UserForm_Terminate()
 ' Alle jpg's löschen:
 Static Datei$
 
 Datei = Dir("C:\OutlookTemp\*.jpg")
 
 If Datei "" Then
 Kill "C:\OutlookTemp\" & Datei
 While Datei ""
 Datei = Dir
 If Datei "" Then Kill "C:\OutlookTemp\" & Datei
 Wend
 End If
End Sub

Unbekannt · Answer

Hallo,

kann mir bitte jemand sagen, wie man das installiert`?

Vielen Dank

FREMDBEITRAG: Makros zum direkten Anzeigen von *.jpg in Outlook

Überblick

Frage

4 Antworten