UserForm Bildvorschau

'User Form:



Option Explicit





Private Sub UserForm_Initialize()



webbrowser1.Navigate gifpfad



End Sub





Private Sub CommandButton1_Click()



'andere GIF auswählen



auswahl = 1



Unload UserForm1



End Sub



Private Sub CommandButton2_Click()



auswahl = 0



Unload UserForm1



End Sub



Private Sub CommandButton3_Click()



End



End Sub





Private Sub UserForm_Click()



End Sub





'----------------------------------------------------



'Module:





Option Explicit

Public gifpfad

Public auswahl



   

Public Sub GifInTerminEinfügen()



Wiederholen:



    On Error GoTo FehlerVerarbeitung



    Dim olApp As Outlook.Application

    Dim olInspector As Outlook.Inspector

    Dim olItem As Object ' Allgemeines Outlook-Element

    Dim fehler1

    Dim HTMLBody As String

    Dim wshshell





    ' Outlook-Anwendung erstellen

    Set olApp = New Outlook.Application



    ' Aktiven Inspector (Elementfenster) abrufen

    Set olInspector = olApp.ActiveInspector



    ' Sicherstellen, dass ein Outlook-Element geöffnet ist

    If Not olInspector Is Nothing Then

        Set olItem = olInspector.CurrentItem



        ' Pop-up-Dialog für die Auswahl des GIF-Pfads anzeigen

        Dim sFolder As String

        Dim xlObj As Object

        Dim xlFolder As Object



        ' Pfad zum Ausgangsordner

        Dim initialFolder As String

    initialFolder = "P:GIF_Datenbank" ' Hier geben Sie den gewünschten Startordner an

        

        If Dir("P:GIF") = "" Then

            Exit Sub

        End If

        

        fehler1 = 0



        Set xlObj = CreateObject("Excel.Application")

        Set xlFolder = xlObj.FileDialog(3)



        ' Den InitialFileName auf den gewünschten Ordner setzen

        xlFolder.InitialFileName = initialFolder



        If xlFolder.Show = -1 Then

            sFolder = xlFolder.SelectedItems(1)

        End If



        xlObj.Quit

        Set xlObj = Nothing



        If sFolder > "" Then

            gifpfad = sFolder

        End If

        

        UserForm1.Show

        

        If auswahl = 1 Then

         GoTo Wiederholen

        End If

        



        ' Den HTML-Code erstellen, um das GIF einzufügen

        If TypeOf olItem Is Outlook.MailItem Then

            ' Wenn es sich um eine E-Mail handelt

            Dim olMailItem As Outlook.MailItem

            Set olMailItem = olItem

            HTMLBody = olMailItem.HTMLBody

        ' Den HTML-Code erstellen, um das GIF an der Cursorposition einzufügen

            If TypeOf olItem Is Outlook.MailItem Then

        ' Wenn es sich um eine E-Mail handelt



            Set olMailItem = olItem

            HTMLBody = olMailItem.HTMLBody

        olMailItem.HTMLBody = HTMLBody

End If

            ' HTML-Code in den E-Mail-Text einfügen

            olMailItem.HTMLBody = HTMLBody

        ElseIf TypeOf olItem Is Outlook.AppointmentItem Then

            ' Wenn es sich um eine Terminnachricht handelt

            Dim olAppointmentItem As Outlook.AppointmentItem

            Set olAppointmentItem = olItem

            

            ' Inspector für das AppointmentItem abrufen

            Dim olInsp As Outlook.Inspector

            Set olInsp = olAppointmentItem.GetInspector

            

            ' Das Word.Document für das AppointmentItem abrufen

            Dim wdDoc As Object

            Set wdDoc = olInsp.WordEditor

            

            ' HTML-Code in das Word.Document einfügen

            wdDoc.range(0, 0).InlineShapes.AddPicture gifpfad, LinkToFile:=False, SaveWithDocument:=True

        Else

            MsgBox "Das aktuell geöffnete Element ist keine E-Mail oder Terminnachricht.", vbExclamation

        End If

    Else

        MsgBox "Es ist kein Elementfenster geöffnet.", vbExclamation

    End If



    ' Aufräumen

    Set olItem = Nothing

    Set olInspector = Nothing

    Set olApp = Nothing





End Sub