Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As mailitem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.item(1)

'macro name you want to run goes here
SaveandOpenAttachments objItem

End Sub



Public Sub SaveandOpenAttachments(objMsg As mailitem)
Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim oAppt As Object

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    On Error Resume Next

    ' Set the Attachment folder. (Folder must exist.)
    strFolderpath = strFolderpath & "\Att temp\"

    Set objAttachments = objMsg.Attachments
    
    lngCount = objAttachments.Count
      If lngCount > 0 Then
        For i = lngCount To 1 Step -1
         strFile = objAttachments.item(i).FileName
         strFile = strFolderpath & strFile
         Debug.Print strFile
         objAttachments.item(i).SaveAsFile strFile

Set oAppt = Session.OpenSharedItem(strFile)
  oAppt.Close olSave

     ' should delete strfile too
   SetAttr strFile, vbNormal
    Kill strFile
  
    Next
    End If
    
ExitSub:
Set objAttachments = Nothing

End Sub