title: Outlook VBA - Filedialog behind windows
body: <p>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 &quot;blocking&quot; 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.</p>
  <p>CODE:</p>
  <pre><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 = 
  &quot;http://schemas.microsoft.com/mapi/proptag/0x3712001F&quot;
  Const PR_ATTACHMENT_HIDDEN As String = 
  &quot;http://schemas.microsoft.com/mapi/proptag/0x7FFE000B&quot;
  
  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(&quot;username&quot;)
  
  testo = mails.HTMLBody
  textcheck = &quot;&lt;div style='border:none;border-top:solid #E1E1E1 1.0pt;padding:3.0pt 0cm 0cm 0cm'&gt;&quot;
  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)) &gt; 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), &quot;allegato&quot;) &gt; 0 Then
  GoTo messaggio
  ElseIf numero = 0 Then
  GoTo test
  Else
  GoTo fine
  End If
  test:        If aFound = False And InStr(LowerCase, &quot;allegato&quot;) &gt; 0 Then
  messaggio:            If MsgBox(&quot;Nell'email hai scritto 'allegato' ma non ne è presente alcuno, vuoi inviarla lo stesso?&quot;, vbYesNo) = vbNo Then
          'nascondo prima le finestre
  Set applicaz = GetObject(, &quot;Outlook.Application&quot;)
  applicaz.ActiveWindow.WindowState = 1
  
  
  Set wdApp = CreateObject(&quot;Word.Application&quot;)
  
  Set dlgOpen = wdApp.FileDialog(msoFileDialogFilePicker)
  With dlgOpen
       .InitialFileName = &quot;C:\Users\&quot; &amp; varia &amp; &quot;\Desktop&quot;
       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 
  </code></pre>
  <p>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!!!</p>