title: Download and Save Attachment from Email Automatically to Excel
body: <p>Currently my code listed below will copy body information from an incoming email and open the designated excel sheet and copy the contents onto the excel sheet and close it. I would also like to save attachments from incoming email to this designated path :C:\Users\ltorres\Desktop\Projects</p>
  
  <p>I have tried this, but this code will not incorporate with outlook. I would have to run it with excel</p>
  
  <hr>
  
  <pre><code>Public Sub saveAttachtoDisk (itm As Outlook.MailItem) 
      Dim objAtt As Outlook.Attachment 
      Dim saveFolder As String
      Dim dateFormat As String
      saveFolder = "C:\Users\ltorres\Desktop\Projects"
      dateFormat = Format(Now, "yyyy-mm-dd H-mm")
  
      For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder &amp; "\" &amp; dateFormat &amp; objAtt.DisplayName
          Set objAtt = Nothing
      Next 
  End Sub
  </code></pre>
  
  <hr>
  
  <pre><code>Const xlUp As Long = -4162
  
  Sub ExportToExcel(MyMail As MailItem)
      Dim strID As String, olNS As Outlook.NameSpace
      Dim olMail As Outlook.MailItem
      Dim strFileName As String
  
      '~~&gt; Excel Variables
      Dim oXLApp As Object, oXLwb As Object, oXLws As Object
      Dim lRow As Long
  
      strID = MyMail.EntryID
      Set olNS = Application.GetNamespace("MAPI")
      Set olMail = olNS.GetItemFromID(strID)
  
      '~~&gt; Establish an EXCEL application object
      On Error Resume Next
      Set oXLApp = GetObject(, "Excel.Application")
  
      '~~&gt; If not found then create new instance
      If Err.Number &lt;&gt; 0 Then
          Set oXLApp = CreateObject("Excel.Application")
      End If
      Err.Clear
      On Error GoTo 0
  
      '~~&gt; Show Excel
      oXLApp.Visible = True
  
      '~~&gt; Open the relevant file
      Set oXLwb = oXLApp.Workbooks.Open("C:\Users\ltorres\Desktop\Projects\Project 2\TemplateFinal\lighting.xlsm")
  
      '~~&gt; Set the relevant output sheet. Change as applicable
      Set oXLws = oXLwb.Sheets("Multiplier")
  
      lRow = oXLws.Range("A" &amp; oXLws.Rows.Count).End(xlUp).Row + 1
  
      '~~&gt; Write to outlook
                          With oXLws
                      lRow = .Range("A" &amp; .Rows.Count).End(xlUp).Row + 1
                      Dim MyAr() As String
                      MyAr = Split(olMail.Body, vbCrLf)
                      For i = LBound(MyAr) To UBound(MyAr)
                          .Range("A" &amp; lRow).Value = MyAr(i)
                          lRow = lRow + 1
                      Next i
                              '
                          End With
  
      '~~&gt; Close and Clean up Excel
      oXLwb.Close (True)
      oXLApp.Quit
      Set oXLws = Nothing
      Set oXLwb = Nothing
      Set oXLApp = Nothing
  
      Set olMail = Nothing
      Set olNS = Nothing
  End Sub
  </code></pre>