Public Sub DoSomethingFolder()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim objItem As Object
    Dim objAttachments As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strExePath As String
 Dim j
 Dim fso As Object
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    strFolderpath = strFolderpath & "\attach\"

Debug.Print strFolderpath

    Set objOL = Outlook.Application
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items
  Set fso = CreateObject("Scripting.FileSystemObject")
  
    For Each obj In objItems
  
     With obj
  
       Debug.Print .SenderName, .Subject


Set objAttachments = obj.Attachments
     
    lngCount = objAttachments.Count
      If lngCount > 0 Then
        For i = lngCount To 1 Step -1
         strFile = objAttachments.Item(i).FileName
 If Right(strFile, 4) = ".msg" Then
 
         strFile = strFolderpath & i & strFile
         objAttachments.Item(i).SaveAsFile strFile
 Debug.Print strFile

Set objItem = Application.CreateItemFromTemplate(strFile) 'Application.ActiveInspector.CurrentItem
 Debug.Print "attachment", objItem.SenderName, objItem.SenderEmailAddress

objItem.Close olDiscard

End If
    Next
    End If
      
     End With
 
    Next
    fso.DeleteFile (strFolderpath & "*.msg")

    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub