Outlook VBA Makro lässt sich nicht aus dem Menüband starten

Hallo,

erstmal vielen Dank für guten Tutorial Clips auf Youtube.

Auf meiner Website habe ich ein Kontaktformular eingebaut. Die Kontaktanfragen werden mittels eines E-Mail-Alias (mail@acme.de) an meine E-Mail-Adresse info@acme.de geschickt.

Diese Mail haben immer den gleichen Aufbau der sich aus den Feldern des Kontaktformulars (Name, E-Mail, Telefon, Nachricht) ergibt:

Name: Name

E-Mail: beispiel@beispiel.de

Telefon: 0123456789

Nachricht: Beispielnachricht

Da der Absender der Nachricht meine eigener Alias mail@acme.de ist, kann ich nicht die normale Antworten Funktion in Outlook benutzen. Um eine Anfrage zu beantworten muss die E-Mail-Adresse aus der Nachricht in einer neue erstellten Nachricht in den Empfänger kopiert werden.

Zur Beantwortung der Anfragen habe ich ein VBA Makro erstellt, dass den Text der Anfragemail mittels regulären Ausdrücken zerlegt und eine Antwortmail generiert.

Public Sub ReplyContactForm()
Dim SelectedMail As Outlook.MailItem
Dim ReplyMail As Outlook.MailItem
Dim stBody As String
Dim stName As String
Dim stEmail As String
Dim stMessage As String
Dim ReceivedDateTime As Date
Dim length As Integer
Dim regex As RegExp
Dim matches As MatchCollection
Dim match As match

If Application.ActiveExplorer.Selection.Count > 0 Then
If TypeOf Application.ActiveExplorer.Selection.Item(1) Is Outlook.MailItem Then

Set SelectedMail = Application.ActiveExplorer.Selection.Item(1)
ReceivedDateTime = SelectedMail.ReceivedTime

‘Prüfen, ob die Mail tatsächlich vom Kontaktformular kommt
If SelectedMail.SenderEmailAddress = “mail@acme.de” Then

‘Auslesen der Kontaktformulardaten
stBody = Trim(SelectedMail.Body)
Set regex = New RegExp
With regex
.IgnoreCase = True
.MultiLine = True
.Global = False
.Pattern = “Name: .+”
End With

If regex.Test(stBody) Then
Set matches = regex.Execute(stBody)
For Each match In matches
length = Len(Trim(match.Value))
stName = Mid(Trim(match.Value), 7, length – 7)
Next match
Else
MsgBox “Keinen Namen gefunden.”
End If

regex.Pattern = “E-Mail: .+”

If regex.Test(stBody) Then
Set matches = regex.Execute(stBody)
For Each match In matches
length = Len(Trim(match.Value))
stEmail = Mid(Trim(match.Value), 9, length – 9)
Next match
Else
MsgBox “Keinen E-Mail gefunden.”
End If

length = Len(stBody)
stMessage = Mid(stBody, InStr(1, stBody, “Nachricht: “, vbTextCompare) + 11)

‘Erstellen der Antwortnachricht
Set ReplyMail = Outlook.Application.CreateItem(olMailItem)

With ReplyMail

.To = stEmail
.Subject = “AW: Anfrage vom ” & ReceivedDateTime
.Body = “Hallo ” & stName & “,” & vbCrLf & vbCrLf & vbCrLf & vbCrLf & “Freundliche Grüße”
.Display
End With

Else
MsgBox “Bitte wähle eine E-Mail vom Kontaktformular der Website aus.”
End If
Else
MsgBox “Bitte wähle eine E-Mail aus.”
End If
Else
MsgBox “Bitte wähle eine E-Mail aus.”
End If

Set SelectedMail = Nothing
Set ReplyMail = Nothing

End Sub

Dieses Makro funktioniert im Makro Editor in Einzelschritten und in der direkten Ausführung (F5). Nun möchte ich das Makro als Funktion im Menüband hinterlegen. Dabei habe ich mich an die Vorgehensweise im Youtube Clip youtube.com/watch?v=QEjpSI_1PqA gehalten. Leider tut sich aber gar nichts, wenn man auf die Schaltfläche clickt.

Was mache ich falsch?