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

Home-›Foren-›Outlook-›Outlook VBA-›FREMDBEITRAG: Makros zum direkten Anzeigen von *.jpg in Outlook

4 Antworten anzeigen - 1 bis 4 (von insgesamt 4)
  • Autor
    Beitrag
  • 27. Mai 2005 um 00:39 #99809
    lastwebpage
    Moderator

      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

      27. Mai 2005 um 00:41 #99811
      lastwebpage
      Moderator

        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

        27. Mai 2005 um 00:44 #99812
        lastwebpage
        Moderator

          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

          11. August 2005 um 00:04 #108542
          Unbekannt
          Participant

            Hallo,

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

            Vielen Dank

          • Autor
            Beitrag
          4 Antworten anzeigen - 1 bis 4 (von insgesamt 4)

          Das Thema ‘FREMDBEITRAG: Makros zum direkten Anzeigen von *.jpg in Outlook’ ist für neue Antworten geschlossen.

          Hat Ihnen der Beitrag gefallen?

          1 Stern2 Sterne3 Sterne4 Sterne5 Sterne (Keine Bewertung vorhanden)
          Loading...