Option
Explicit
Private
m_olAPP
As
Object
Sub
main()
Set
m_olAPP = fgetOutlookApplication()
If
m_olAPP =
Nothing
Then
Exit
Sub
With
m_olAPP
End
With
Set
m_olAPP =
Nothing
End
Sub
Function
fgetOutlookApplication()
As
Object
On
Error
GoTo
FinishErr
Set
fgetOutlookApplication = GetObject(class:=
"Outlook.Application"
)
FinishErr:
Select
Case
Err.Number
Case
0
Case
429
Set
fgetOutlookApplication = CreateObject(class:=
"Outlook.Application"
)
Resume
Next
Case
Else
Set
fgetOutlookApplication =
Nothing
End
Select
End
Function