【发布时间】：2015-07-03 03:50:25
【问题描述】：
我遇到了 Outlook 自动化问题，
为简单起见，我将首先向您展示我的代码的较短版本：
Sub test()
Dim GetOutlookApp As Object
Set GetOutlookApp = CreateObject("Outlook.Application")
End Sub
首先，我确实想保留后期绑定解决方案。
此子在任务栏中启动 Outlook（小图标）。当我双击它时，会弹出一条消息：“未找到活动的资源管理器对象”（窗口标题：“错误”）。然后，当我单击“确定”时，Outlook 收件箱窗口打开。
我的脚本是为最终用户准备的，所以即使用户只需单击“确定”，我也不希望出现此消息（主子程序的其余部分没有任何问题）。
我必须解决这个问题才能使用 Outlook 发送电子邮件并确保电子邮件不在发件箱文件夹中。
我正在寻找的是一种使用后期绑定打开 Outlook 的方法，没有此消息。
以下是发送电子邮件前打开 Outlook 的完整代码（来源：ron de bruin）。除了前景消息外，它工作得很好。该行弹出消息：
obj.Session.GetDefaultFolder(olFolderInbox).Display
我尝试了 AppActivate 和其他东西，但我没有成功，并且在谷歌上找不到任何相关信息！
感谢您的帮助
Sub send_mail ()
Dim OutApp As Object
Set OutApp = OutlookApp() 'OPEN OUTLOOK
'Set OutApp = CreateObject("Outlook.Application") 'OPEN OUTLOOK simple solution
With ActiveSheet.MailEnvelope
...
End With
End sub
Public Function OutlookApp( _
Optional WindowState As Long = olMaximized, _
Optional ReleaseIt As Boolean = True _
) As Object
'***This sub is a part to the global way to open outlook before sending an email (prevent the outbox bug, email stucked into the outbox)
'***Source: http://www.rondebruin.nl/win/s1/outlook/openclose.htm, late binding mode
Static obj As Object
On Error GoTo ErrHandler
Select Case True
Case obj Is Nothing, Len(obj.Name) = 0
Set obj = GetObject(, "Outlook.Application")
If obj.Explorers.Count = 0 Then
InitOutlook:
'Open inbox to prevent errors with security prompts
obj.Session.GetDefaultFolder(olFolderInbox).Display
obj.ActiveExplorer.WindowState = WindowState
End If
Case ReleaseIt
Set obj = Nothing
End Select
Set OutlookApp = obj
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case -2147352567
'User cancelled setup, silently exit
Set obj = Nothing
Case 429, 462
MsgBox "Err.Number OutlookApp: " & Err.Number
Set obj = GetOutlookApp()
If obj 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
Private Function GetOutlookApp() As Object
'***This sub is a part to the global way to open outlook before sending an email (prevent the outbox bug, email stucked into the outbox)
'***Source: http://www.rondebruin.nl/win/s1/outlook/openclose.htm, late binding mode
'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
【问题讨论】：
-
你试过转
Application.DisplayAlerts= false吗？同样，您可以尝试OutlookApp.DisplayAlerts=false，虽然还没有尝试过 -
是的，我试过了，但没有解决问题。 :(我忘了说使用VBA文件时，在“obj.Session.GetDefaultFolder(olFolderInbox).Display”代码行上弹出消息。