如何用VBA打开Outlook

时间:2015-10-25 09:49:17

标签: vba outlook

我想用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

4 个答案:

答案 0 :(得分:5)

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

Sub Open_Outlook()

Shell ("OUTLOOK")

End Sub

答案 1 :(得分:2)

有关示例代码,请参阅How to automate Outlook from another program。您可以使用GetObject方法获取正在运行的Outlook实例,而不是创建新实例:

Set objOutlook = GetObject(, "Outlook.Application")

然而,Outlook是一个单身人士。每次调用CreateObject方法时,您都会获得相同的实例。您无法同时运行两个Outlook实例。有关详细信息,请参阅GetObject in Word VBA script to find Outlook instance fails with 429 error unless both apps running as administrator

请注意, Microsoft目前不建议并且不支持从任何无人参与的非交互式客户端应用程序或组件(包括ASP,ASP.NET,DCOM和NT服务)自动化Microsoft Office应用程序,因为Office在此环境中运行时可能会出现不稳定的行为和/或死锁。

如果要构建在服务器端上下文中运行的解决方案,则应尝试使用已为安全无人值守执行的组件。或者,您应该尝试找到允许至少部分代码在客户端运行的替代方法。如果从服务器端解决方案使用Office应用程序,则应用程序将缺少许多成功运行的必要功能。此外,您将承担整体解决方案稳定性的风险。请在Considerations for server-side Automation of Office文章中详细了解相关内容。

答案 2 :(得分:1)

你可以使用更简单的东西:

Sub EmailMe()

dim mail as object
dim msg as object

set mail= createobject("Outlook.Application")
set msg=mail.createitem(0)

 with msg
  .to="someone@something.com;...."
  .subject="What are you sending this for"  
  .body"Whatever you want to say"
  .attachment.add Activeworkbook.fullname
  .send
 end with

end sub

答案 3 :(得分:0)

Dim oOutlook As Object

On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOutlook Is Nothing Then
    Shell ("OUTLOOK")
Else
    'already open
End If