Outlook VBA - Filedialog behind windows-CodePudding

I am having trouble with a filedialog in Outlook VBA Macros, the problem is that the filedialog is generated by a word application and when it opens, it always opens behind all the windows, the opened email is hided, while the main Outlook application remains opened causing a "blocking" because the filedialog demands an action (maybe the code below will help you to understand better). Every time I have to click the button to return on the desktop and then use the filedialog.

CODE:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim applicazi As Object
Dim applicaz As Object
Dim myinspecto As Outlook.Inspector
Dim myItemz As Outlook.mailItem
Dim ispettore As Outlook.Inspector
Dim mails As mailItem

Const PR_ATTACH_CONTENT_ID As String = 
"http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = 
"http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

Set ispettore = Application.ActiveInspector
On Error Resume Next
Set mails = GetCurrentItem()
On Error Resume Next


Dim UpperCase As String, LowerCase As Strin
On Error Resume Next
UpperCase = mails.HTMLBody
On Error Resume Next
LowerCase = LCase(UpperCase)
On Error Resume Next
 Dim it As Variant

Dim wdApp1 As Object ' Word.Application
Dim dlgOpen1 As Object ' FileDialog
Dim strFile1 As String

 Dim itemcorr As Outlook.mailItem
 Dim miallegati As Outlook.Attachments
Dim rangea As String
Dim textcheck As String
Dim numero As String
Dim testo As String
Dim wdApp As Object
Dim varia As String

varia = Environ("username")

testo = mails.HTMLBody
textcheck = "<div style='border:none;border-top:solid #E1E1E1 1.0pt;padding:3.0pt 0cm 0cm 0cm'>"
numero = InStr(testo, textcheck)
rangea = Left(testo, numero)

Dim aFound As Boolean
Dim a As Object
Dim dlgOpen As FileDialog


Set miallegati = mails. Attachments


aFound = False

If TypeOf Item Is Outlook.mailItem Then

    For Each a In Item.Attachments
        On Error Resume Next ' to avoid the error thrown when no items within         attachments have this property
        If a.PropertyAccessor.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
            If Len(a.PropertyAccessor.GetProperty(PR_ATTACH_CONTENT_ID)) > 0 And     InStr(Application.ActiveInspector.CurrentItem.HTMLBody, a.PropertyAccessor.GetProperty(PR_ATTACH_CONTENT_ID)) Then
            Else
            aFound = True
            Exit For
            End If
    End If


        On Error GoTo 0
     Next a
     
     'devi mettere il case sensitive, rangea ha delle maiuscole
If aFound = False And InStr(LCase(rangea), "allegato") > 0 Then
GoTo messaggio
ElseIf numero = 0 Then
GoTo test
Else
GoTo fine
End If
test:        If aFound = False And InStr(LowerCase, "allegato") > 0 Then
messaggio:            If MsgBox("Nell'email hai scritto 'allegato' ma non ne è presente alcuno, vuoi inviarla lo stesso?", vbYesNo) = vbNo Then
        'nascondo prima le finestre
Set applicaz = GetObject(, "Outlook.Application")
applicaz.ActiveWindow.WindowState = 1


Set wdApp = CreateObject("Word.Application")

Set dlgOpen = wdApp.FileDialog(msoFileDialogFilePicker)
With dlgOpen
     .InitialFileName = "C:\Users\" & varia & "\Desktop"
     dlgOpen.AllowMultiSelect = True

  
If dlgOpen.Show = -1 Then

  For Each it In dlgOpen.SelectedItems

     mails.Attachments.Add it
     Next it
     
        mails. Display
Else
' user clicked cancel
Cancel = True

End If

End With

        End If
       
    End If
   
End If
fine: End Sub

I hope I've explained well enough, I'm sorry but this is the first time that I use this website. Thank you very much!!!

CodePudding user response：

The issue is caused by the fact that Word dialog windows don't know anything about Outlook windows. You must set a parent window to your child window dialog if you want to keep it always on top of another window. For example:

Public Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long

Public Sub Bring_to_front()
    Dim setFocus As Long

    setfocus = SetForegroundWindow(WordApplication.ActiveWindow.HWND)
End Sub

See Excel FilePicker dialogbox in Outlook code opens in background for more information.