title: Outlook VBA Email Autosave
body: <p>I'm using the code below to automatically save emails as they arrive.  The issue I have is that emails that are only in the default inbox are saved.  I've searched a bit and tried a few tweaks, but I'm new to VBA and nothing has seemed to work yet.</p>
  
  <pre><code>    Option Explicit
  
      Public Enum olSaveAsTypeEnum
        olSaveAsTxt = 0
        olSaveAsRTF = 1
        olSaveAsMsg = 3
      End Enum
  
      Private WithEvents Items As Outlook.Items
  
      Private Const MAIL_PATH As String = "C:\Users\xxxxx\My Documents\Emails\"
  
      Private Sub Application_Startup()
        Dim Ns As Outlook.NameSpace
  
        Set Ns = Application.GetNamespace("MAPI")
        Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
      End Sub
  
      Private Sub Items_ItemAdd(ByVal Item As Object)
        If TypeOf Item Is Outlook.MailItem Then
          SaveMailAsFile Item, olSaveAsMsg, MAIL_PATH
        End If
      End Sub
  
      Private Sub SaveMailAsFile(oMail As Outlook.MailItem, _
        eType As olSaveAsTypeEnum, _
        sPath As String _
      )
        Dim dtDate As Date
        Dim sName As String
        Dim sFile As String
        Dim sExt As String
  
        Select Case eType
          Case olSaveAsTxt: sExt = ".txt"
          Case olSaveAsMsg: sExt = ".msg"
          Case olSaveAsRTF: sExt = ".rtf"
          Case Else: Exit Sub
        End Select
  
        sName = oMail.Subject
        ReplaceCharsForFileName sName, "_"
  
        dtDate = oMail.ReceivedTime
        sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
          vbUseSystem) &amp; Format(dtDate, "-hhnnss", _
          vbUseSystemDayOfWeek, vbUseSystem) &amp; "-" &amp; sName &amp; sExt
  
        oMail.SaveAs sPath &amp; sName, eType
      End Sub
  
      Private Sub ReplaceCharsForFileName(sName As String, _
        sChr As String _
      )
        sName = Replace(sName, "/", sChr)
        sName = Replace(sName, "\", sChr)
        sName = Replace(sName, ":", sChr)
        sName = Replace(sName, "?", sChr)
        sName = Replace(sName, Chr(34), sChr)
        sName = Replace(sName, "&lt;", sChr)
        sName = Replace(sName, "&gt;", sChr)
        sName = Replace(sName, "|", sChr)
      End Sub
  </code></pre>
  
  <p>I have tried this change below.</p>
  
  <pre><code>Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
  
    Set Ns = Application.GetNamespace("MAPI")
    Set Items = Ns.Folders.Item("Inbox").Items
  End Sub
  
  Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
      SaveMailAsFile Item, olSaveAsMsg, MAIL_PATH
    End If
  End Sub
  </code></pre>
  
  <p>But I get an object not found error.</p>