Dim oOutlook As Object       ' Outlook Object
        Dim oNamespace As Object     ' Namespace Object
        Dim oFolder As Object        ' MapiFolder Object
        Dim oMail As Object          ' Mail Object
        Dim oAnhang As Object        ' Attachment Object
        Dim i As Integer
        Dim j As Integer
 
        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)
 
        ' Alle Mails durchlaufen
        i = 1
        j = oFolder.Items.Count
        Do While j > 0
            oMail = oFolder.Items(j)
 
            ' Auf Anhang prüfen und evtl. speichern
            With oMail.Attachments
                i = .Count
                Do While (i > 0)
                    oAnhang = .Item(i)
                    oAnhang.SaveAsFile(sPath & CStr(i) & "_" & _
                      oAnhang.DisplayName)
                    i = i - 1
                Loop
            End With
 
            ' Nachricht speichern
            'oMail.SaveAs(sPath & CStr(i) & "_" & oMail.Subject & ".txt", olTXT)
            j = j - 1
        Loop
 
        ' Fertig
        MsgBox("Done")

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

Zitat:

Aufgabe ist es, mit einem vb.net Programm die Dateianhänge von Mails in einem Unterordner zu extrahieren. Bevor jetzt einer mit VBA anfängt, jaaa... das geht, aber aus Sicherheitsgründen (Makro-Sicherheitsrichtlinien) fällt dieser Weg aus.

Function GetFolder(ByVal FolderPath As String) As Outlook.folder
 Dim TestFolder As Outlook.folder
 Dim FoldersArray As Variant
 Dim i As Integer
 
 On Error GoTo GetFolder_Error
 If Left(FolderPath, 2) = "\\" Then
 FolderPath = Right(FolderPath, Len(FolderPath) - 2)
 End If
 'Convert folderpath to array
 FoldersArray = Split(FolderPath, "\")
 Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
 If Not TestFolder Is Nothing Then
 For i = 1 To UBound(FoldersArray, 1)
 Dim SubFolders As Outlook.Folders
 Set SubFolders = TestFolder.Folders
 Set TestFolder = SubFolders.Item(FoldersArray(i))
 If TestFolder Is Nothing Then
 Set GetFolder = Nothing
 End If
 Next
 End If
 'Return the TestFolder
 Set GetFolder = TestFolder
 Exit Function
 
GetFolder_Error:
 Set GetFolder = Nothing
 Exit Function
End Function
 
Sub TestGetFolder()
 
 Dim folder As Outlook.folder
 Set folder = GetFolder("\\DeinPostfach@Irgendwas.de\Test")
 If Not (folder Is Nothing) Then
 'folder.Display
 
 
Dim i As Integer
 
For i = 1 To folder.Items.Count
MsgBox (folder.Items(i))
Next
 
 End If
End Sub

EALA FREYA FRESENA