如何用VBA打开Outlook

Question

我喜欢用VBA打开Outlook.它应该检查outlook是否开放,如果没有,那么它应该打开它.我有代码,但它很大,有时不与其他宏使用Call函数.什么应该是简单和短的代码来做到这一点,并与所有版本一起使用？

#Const LateBind = True

Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6

#If LateBind Then

Public Function OutlookApp( _
    Optional WindowState As Long = olMinimized, _
    Optional ReleaseIt As Boolean = False _
    ) As Object
    Static o As Object
#Else
Public Function OutlookApp( _
    Optional WindowState As outlook.OlWindowState = olMinimized, _
    Optional ReleaseIt As Boolean _
) As outlook.Application
    Static o As outlook.Application
#End If
On Error GoTo ErrHandler

    Select Case True
        Case o Is Nothing, Len(o.Name) = 0
            Set o = GetObject(, "Outlook.Application")
            If o.Explorers.Count = 0 Then
InitOutlook:
                'Open inbox to prevent errors with security prompts
                o.session.GetDefaultFolder(olFolderInbox).Display
                o.ActiveExplorer.WindowState = WindowState
            End If
        Case ReleaseIt
            Set o = Nothing
    End Select
    Set OutlookApp = o

ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case -2147352567
            'User cancelled setup, silently exit
            Set o = Nothing
        Case 429, 462
            Set o = GetOutlookApp()
            If o Is Nothing Then
                Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
            Else
                Resume InitOutlook
            End If
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
    End Select
    Resume ExitProc
    Resume
End Function

#If LateBind Then
Private Function GetOutlookApp() As Object
#Else
Private Function GetOutlookApp() As outlook.Application
#End If
On Error GoTo ErrHandler

    Set GetOutlookApp = CreateObject("Outlook.Application")

ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case Else
            'Do not raise any errors
            Set GetOutlookApp = Nothing
    End Select
    Resume ExitProc
    Resume
End Function

Sub open_outlook()
    Dim OutApp  As Object
    Set OutApp = OutlookApp()
    'Automate OutApp as desired
End Sub

Answer 1

我想你可以尝试下面的代码.我尝试在我的所有VBA编码中打开最短的代码.

Sub Open_Outlook()

Shell ("OUTLOOK")

End Sub