Resolvido!
Em vez de:
AppActivate Application.Caption
Isto:
SendKeys "% i"
Então:
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