Gelöst!
Anstatt:
AppActivate Application.Caption
Diese:
SendKeys "% i"
Dann:
Option Explicit Sub Test() Dim Outlook As Object Set Outlook = CreateOutlook() Set Outlook = Nothing End Sub Function CreateOutlook() As Object Dim Minimize As Boolean Dim Outlook As Object Minimize = False On Error Resume Next Set Outlook = GetObject(, "Outlook.Application") On Error GoTo 0 If Outlook Is Nothing Then Shell "Outlook" Minimize = True End If On Error Resume Next Do While Outlook Is Nothing Set Outlook = GetObject(, "Outlook.Application") Loop On Error GoTo 0 If Minimize Then SendKeys "% i" Set Outlook = Nothing Set CreateOutlook = CreateObject("Outlook.Application") End Function