Question

我分别打了3个程序：

Sub SendMail()
    OutlookSendMail strTo:="DesEMailAddress", _
        strSubject:="BackUp DB", _
        strBody:=ThisWorkbook.name & vbCr, _
        strAttach:=sFile

    OpenOutlook

    MinimizeOutlookWindow

End Sub

不幸的是第三个（MinimizeOutlookWindow）似乎是这个顺序的评论！（不工作）

否则如果我在打开Outlook窗口时在另一个子例程中完全运行它，它会真正地最小化窗口。

如何解决这个问题，因为MinimizeOutlookWindow过程会最小化上面SendMail子例程中打开的Outlook窗口？

以下是上述三个子程序的主体：

Sub OutlookSendMail(strTo As String, strSubject As String, Optional strBody As String, Optional strAttach As String, Optional strPf As String)

Dim objOLApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objMail As Outlook.MailItem
Dim objFolder As Outlook.Folder
Dim blnOLOpen As Boolean

On Error Resume Next
Set objOLApp = GetObject(, "Outlook.Application")
blnOLOpen = True
If objOLApp Is Nothing Then
    Set objOLApp = CreateObject("Outlook.Application")
    blnOLOpen = False
End If
On Error GoTo 0
Set objNS = objOLApp.GetNamespace("MAPI")
If strPf = vbNullString Then strPf = "Outlook"
objNS.Logon Profile:=strPf, ShowDialog:=False, NewSession:=True ', Password:="password"
'Set objFolder = objNS.Folders("AirP Co").Folders("AirP")
Set objMail = objOLApp.CreateItem(olMailItem)

With objMail
    .To = strTo
    .CC = ""
    .BCC = ""
    .subject = strSubject
    .body = strBody
    .bodyFormat = olFormatHTML
    .HTMLBody = "Hi, <p> Back Up.</p>Take care <strong> M</strong> in life."
    If strAttach <> vbNullString Then .Attachments.Add strAttach
    .DeferredDeliveryTime = DateAdd("s", 0, Now())
    .Importance = olImportanceHigh
    .ReadReceiptRequested = True
    .Send
End With
objNS.Logoff

If blnOLOpen = False Then objOLApp.Quit

Set objMail = Nothing
Set objOLApp = Nothing

End Sub 'OutlookSendMail

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
' Open an Outlook window    
Public Sub OpenOutlook()
    Dim ret As Long
    Dim SW_SHOWNORMAL As Variant
    On Error GoTo ErrHandler
    ret = ShellExecute(Application.hwnd, vbNullString, "Outlook", vbNullString, "C:\", SW_SHOWNORMAL)
    If ret < 3 Then
        MsgBox "Error in Outlook accessible", vbCritical, "Error!"
    End If

ErrHandler:
End Sub 'OpenOutlook

' Minimize an Outlook window
Sub MinimizeOutlookWindow()
  On Error Resume Next
  With GetObject(, "Outlook.Application")
    .ActiveWindow.WindowState = 1   ' olMinimized = 1
  End With
End Sub 'MinimizeOutlookWindow

更新

关键是包含附件未发送的邮件直到打开Outlook窗口。
我在OpenOutlook程序中的MinimizeOutlookWindow之前调用了End Sub和OutlookSendMail个程序，问题仍然存在。

Answer 1

没有可见的命令，但您可以激活资源管理器窗口以使刚刚打开的Outlook实例可见。

您不再需要OpenOutlook才能看到Outlook。

Sub OutlookSendMail(strTo As String, strSubject As String, Optional strBody As String, _
    Optional strAttach As String, Optional strPf As String)

Dim objOLApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objMail As Outlook.MailItem

'Dim blnOLOpen As Boolean

Dim olFolder As Folder
Dim olExplorer As Explorer

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

'blnOLOpen = True

If objOLApp Is Nothing Then

    Set objOLApp = CreateObject("Outlook.Application")
    'blnOLOpen = False

    Set objNS = objOLApp.GetNamespace("MAPI")

    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set olExplorer = olFolder.GetExplorer(olFolderDisplayNormal)
    olExplorer.Activate

End If

Set objMail = objOLApp.CreateItem(olMailItem)

With objMail
    .To = strTo
    .Subject = strSubject
    .Send
End With

'If blnOLOpen = False Then objOLApp.Quit

Set objMail = Nothing
Set objNS = Nothing
Set objOLApp = Nothing

Set olFolder = Nothing
Set olExplorer = Nothing

End Sub 'OutlookSendMail

Answer 2

这看起来像是误用On Error Resume Next的另一种情况。

Sub OpenOutlook_MinimizeImmediately()

    OpenOutlook
    MinimizeOutlookWindow

End Sub

' Open an Outlook window
Public Sub OpenOutlook()

    Dim ret As Long
    Dim SW_SHOWNORMAL As Variant

    ret = ShellExecute(Application.hwnd, vbNullString, "Outlook", vbNullString, "C:\", SW_SHOWNORMAL)
    If ret < 3 Then
        MsgBox "Error in Outlook accessible", vbCritical, "Error!"
    End If

End Sub 'OpenOutlook

Sub MinimizeOutlookWindow()

    Dim olApp As Object

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

    If Not olApp Is Nothing Then
        olApp.ActiveWindow.WindowState = 1   ' olMinimized = 1
    Else
        Debug.Print "Outlook not yet available. Run MinimizeOutlookWindow again."
    End If

End Sub

使用这种粗略的方法，窗口最终会出现时最小化。

Sub MinimizeOutlookWindowQuickAndDirty()

    Dim olApp As Object

    ' Be sure there will be an Outlook Window

waitForWindow:

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

    If Not olApp Is Nothing Then
        olApp.ActiveWindow.WindowState = 1   ' olMinimized = 1
    Else
        Debug.Print Now & " Outlook not yet available."
        GoTo waitForWindow
    End If

End Sub

MinimizeOutlookWindow不起作用

更新

2 个答案: