title: Adding an Appointment sent as an Attachment to a Calendar
body: <p>Automated emails with .ics attachments are being received in an Outlook Shared mailbox.</p>
  <p>I am trying to open that attachment, and save that Meeting/Appointment to the Calendar.</p>
  <p>I tried a number of ways. For my latest iteration I am hoping to add this macro directly on the Shared Calendar's mailbox. Let me know if it makes more sense for the emails to be sent to my personal Outlook mailbox, where I then call the macro from a &quot;run a script&quot; Outlook Rule, and route it to the Shared Calendar.</p>
  <pre class="lang-vb prettyprint-override"><code>Sub SaveAttatchments()
      
      ' This Outlook macro checks at the Outlook Inbox for messages
      ' with attached files (of *.ics type) and put a entry in the calendar.
      
      On Error GoTo SaveAttachments_err
      
      Dim InboxFolder As Outlook.Folder
      Dim myCalendarFolder As Outlook.Folder
      Dim myMtgReq As Outlook.MeetingItem 
      Dim mynamespace As Outlook.NameSpace
      Dim Atmt As Attachment
      Dim FileName As String
      Dim i As Integer
      
      Set mynamespace = Application.GetNamespace(&quot;MAPI&quot;)
      Set InboxFolder = mynamespace.GetDefaultFolder(olFolderInbox)
      Set myCalendarFolder = mynamespace.GetDefaultFolder(olFolderCalendar)
      
      FilePath = &quot;C:\temp\&quot;
      
      ' Check each message for attachments
      For Each Item In InboxFolder.Items
          For Each Atmt In Item.Attachments
              If Right(Atmt.FileName, 3) = &quot;ics&quot; Then
  
                  'Save the attachment in folder
                  FileName = FilePath &amp; Atmt.FileName
                  Atmt.SaveAsFile FileName
  
                  'Import the ics from the folder and put an entry in Calendar
                  Set myMtgReq = mynamespace.OpenSharedFolder(FileName)
                  myMtgReq.GetAssociatedAppointment (True)
                  i = i + 1
      
              End If
          Next Atmt
      Next Item
  
  SaveAttachments_exit:
      
      Set Atmt = Nothing
      Set Item = Nothing
      Set myMtgReq = Nothing
      Exit Sub
  
  SaveAttachments_err:
      MsgBox &quot;An unexpected error has occurred.&quot; _
      &amp; vbCrLf &amp; &quot;Please note and report the following information.&quot; _
      &amp; vbCrLf &amp; &quot;Macro Name: SaveAttachments&quot; _
      &amp; vbCrLf &amp; &quot;Error Number: &quot; &amp; Err.Number _
      &amp; vbCrLf &amp; &quot;Error Description: &quot; &amp; Err.Description _
      , vbCritical, &quot;Error!&quot;
      Resume SaveAttachments_exit
      
  End Sub
  </code></pre>
  <p>I get the following:</p>
  <blockquote>
  <p>&quot;Outlook cannot perform this action on this type of attachment.&quot;</p>
  </blockquote>