MinimizeOutlookWindow not works

问题

I have calling 3 procedures respectively:

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

    OpenOutlook

    MinimizeOutlookWindow

End Sub

Unfortunately the third one (MinimizeOutlookWindow) seems a comment in this order! (not working)

Else if I do run that absolutely in another subroutine when Outlook window is opened, it minimizing the window truly.

How can solve this as MinimizeOutlookWindow procedure do minimizing the opened Outlook window in above SendMail subroutine?

Here is the bodies of above three subroutines:

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

Update

The point is the Mail which containing an attachment not sending until opening the Outlook window.
I Called OpenOutlook and MinimizeOutlookWindow procedures before End Sub in the OutlookSendMail procedure, and the issue was persists.

回答1:

There is no visible command but you could activate an explorer window to make the just opened Outlook instance visible.

You would no longer need OpenOutlook to see 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

回答2:

It looks like another case of misuse of 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

With this crude method, the window is minimized when it finally appears.

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

来源：https://stackoverflow.com/questions/48144854/minimizeoutlookwindow-not-works

标签

vba

excel-vba

outlook

outlook-vba