ich habe ein Makro und ein Userform in Outlook VBA ertsellt/ geschrieben, welches einwandfrei funktioniert, wenn ich es über den VBA-Editor ausführe.
Wenn ich nun im Menüband im Registerkarte eine neue Gruppe einfüge, das Makro als Befehl diesem zuweise und das Makro darüber starte passiert Folgendes:
Mein Code sieht so aus:
'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
Das GIF wird außerhalb des UserForms angezeigt. Kennt sich da jemand aus und könnte mir weiterhelfen.
Freundliche Grüße :)
Betül