Imports System.Text
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
 
 
Public Class Form1
 
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) _
      Handles Button1.Click
 
        Dim oOutlook As Object       ' Outlook Object
        Dim oNamespace As Object     ' Namespace Object
        Dim oFolder As Object        ' MapiFolder Object
 
        Dim subFolder As Microsoft.Office.Interop.Outlook.MAPIFolder = Nothing
 
        Const olFolderInbox = 6
        Const olTXT = 0
 
        On Error Resume Next
 
        ' Outlook-Objekt erstellen
        oOutlook = CreateObject("Outlook.Application")
 
        ' Namespace: MAPI
        oNamespace = oOutlook.GetNamespace("MAPI")
 
        oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
 
        subFolder = oFolder.Folders("UNTERORDNER") 'folder.Folders[1]; also 
        ' works
 
        Dim oItems As Outlook.Items
 
        For Each collectionItem As Object In subFolder.Items
 
            Dim newEmail As Outlook.MailItem = TryCast(collectionItem, _
              Outlook.MailItem)
 
            If newEmail.UnRead = True Then
 
                If newEmail.Attachments.Count > 0 Then
                    For i As Integer = 1 To newEmail.Attachments.Count
                        'Dim filePath As String = Path.Combine( 
                        ' destinationDirectory, newEmail.Attachments( 
                        ' i).FileName)
                        Print(1, "-> " & newEmail.Attachments.Item( _
                          i).FileName & vbCrLf)
 
                        newEmail.Attachments(i).SaveAsFile( _
                          Application.StartupPath & "\" & _
                          newEmail.Attachments.Item(i).FileName)
                    Next i
                End If
 
            End If
 
 
        Next collectionItem
 
        FileClose(1)
 
    End Sub
End Class