title: Automaticaly create a windows folder to store Outlook e-mail attachments
body: <p>I have a code that works perfectly when I run it in VBA/EXCEL. I created a module, and wrote the code below.</p>
  
  <p>When I run the macro, It takes every e-mail in the outlook folder and create a new folder for each email with it's own attachments. </p>
  
  <p>It's fine, but I have to run the macro to see the results. I want the process to be automatic, I dont want to have to run something. I want the automatic folder creation and attachments storage to be automaticaly done when I receive an email.</p>
  
  <p>Thank you for your help. </p>
  
  <pre><code>Option Explicit
  
  Sub Application_Startup()
  
  Dim ol As Outlook.Application
  Dim ns As Outlook.Namespace
  Dim fol As Outlook.Folder
  Dim i As Object
  Dim mi As Outlook.MailItem
  Dim at As Outlook.Attachment
  Dim rootfol As Outlook.Folder
  Dim fso As Scripting.FileSystemObject
  Dim dir As Scripting.Folder
  Dim dirName As String
  
  
  
  Set fso = New Scripting.FileSystemObject
  
  Set ol = New Outlook.Application
  Set ns = ol.GetNamespace("MAPI")
  Set rootfol = ns.Folders(1)
  Set fol = rootfol.Folders("boîte de réception").Folders("test")
  
  For Each i In fol.Items
          If i.Class = olMail Then
                  Set mi = i
                  If mi.Attachments.Count &gt; 0 Then
  
                 dirName = "C:\Users\chadi\OneDrive\Documents\VBA\" &amp; Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") &amp; Left(Replace(mi.Subject, ":", ""), 20)
  
                If fso.FolderExists(dirName) Then
            Set dir = fso.GetFolder(dirName)
                Else
            Set dir = fso.CreateFolder(dirName)
  
            Dim mySpecialWordDocument As String
            mySpecialWordDocument = "C:\Users\chadi\OneDrive\Documents\Scanned Documents\CHADICV.docx"
            fso.CopyFile mySpecialWordDocument, dirName &amp; "\" &amp; Split(mySpecialWordDocument, "\")(UBound(Split(mySpecialWordDocument, "\")))
  
         End If
  
                  For Each at In mi.Attachments
                  at.SaveAsFile dir.Path &amp; "\" &amp; at.Filename
  
  
                  Next at
  
                  End If     
          End If
  
      Next i
  
  
  End Sub
  
  
  </code></pre>