Ok, ich gebe zu, es ist ein sehr spezielles Problem, aber wenn man davor steht und keine Lösung hat, dann nervt es. Die Anpassung der Kontaktformular hat keine Auswirkung auf bereits vorhandenen Kontakte. Mit Hilfe dieses Skripts kann man das nachträglich anwenden.
Ausgangslage: Anpassungen am Kontaktformular von Outlook
Dazu gibt es bereits einige Webseiten:
- Man aktiviert das Band mit der Entwickler-Menüleiste
- Entwirft das Formular usw.
- Speichert das Formular in Outlook (funktioniert auch mit gemeinsamen Outlookkontakte Ordner)
- Dann setzt man den Standard links auf diesem Kontakteordner mit der rechten Maustaste (bisher alles easy)
Anpassungen gelten nur für neue Kontakte nicht aber für bereits vorhandene Outlook Kontaktelemente
Problematisch ist jedoch die Tatsache, dass diese Anpassungen am Outlook Kontaktformular keine Auswirkung auf die alten Kontakte haben. Die vorhandenen Elemente bleiben alle unverändert.
VBA-Skript zum nachträglichen Anpassen der Kontaktformulare in Outlook
Hier kommt ein Skript mit dem man markierte Outlook Kontaktelemente nachträglich auf die neue Formular Variante zuordnen kann.
Das Makro muss über den Menüpunkt Makros (denkt daran das Entwickler-Menüband zu aktivieren) angesteuert werden. Dort kann man das speichern und ausführen.
Sub KontakteFormularMassenAenderung()
Dim objSelection As Outlook.Selection
Dim i As Long
Dim objItem As Object
Dim strOldForm, strNewForm As String
'Get all selected items
Set objSelection = Outlook.Application.ActiveExplorer.Selection
If objSelection Is Nothing Then
MsgBox "No item is selected.", vbExclamation + vbOKOnly
Else
'Input the name of new form
strNewForm = InputBox("Enter the name of new form:", , "IPM.Contact.Outlook_Formular_2021-08-21")
If strNewForm <> "" Then
For i = objSelection.Count To 1 Step -1
Set objItem = objSelection(i)
strOldForm = objItem.MessageClass
'Assign the new form to the selected items
If LCase(strNewForm) <> LCase(strOldForm) Then
objItem.MessageClass = strNewForm
objItem.Save
End If
Next
MsgBox "Successfully completed!", vbInformation + vbOKOnly
End If
End If
End Sub
