Private Const EMailAddresse As String = "TestEmail@T-Online.de"
Private Const S_OK As Long = 0
 
'Es ist ein Verweis auf Microsoft Excel Object Library erforderlich
'Errors:
' 0 = Success
' -1 Excel Object nicht instanzierbar
' -2 Datei nicht gefunden
' -3 Outlook Postfach existiert in der angegebenen Domäin nicht
Public Function WriteEMailSubjectToExcel(ByVal sFile As String, _
                                    ByVal sTable As String, _
                                    ByVal sPostFach As String) As Long
   Dim oExl As Excel.Application
   Dim oWrk As Excel.Workbook
   Dim oNs As Outlook.NameSpace
   Dim oFol As Outlook.Folder
   Dim oMail As Outlook.MailItem
   Dim nRow As Long
 
   'Prüfen ob eine Instanz von Excel erzeugt werden kann
   Set oExl = CreateObject("Excel.Application")
   If ObjPtr(oExel) = 0 Then
       WriteEMailSubjectToExcel = -1
       Exit Function
   End If
   'Datei öffnen
   If Dir(sFile) = "" Then
       Set oExl = Nothing
       WriteEMailSubjectToExcel = -2
       Exit Function
   End If
   Set oExl.Visible = False
   Set oWrk = oExl.Workbooks.Open(sFile)
   oWrk.Sheets(sTable).Select
 
   'Outlook
   Set oNs = Application.GetNamespace("MAPI")
   Set oFol = oNs.Folders(EMailAddresse).Folders(sPostFach)
   If ObjPtr(oFol) = 0 Then
       WriteEMailSubjectToExcel = -3
       oWrk.Close
       oExl.Quit
       Set oExl = Nothing
   End If
 
   For Each oMail In oFol.Items
       nRow = nRow + 1
       oWrk.ActiveSheet.Cells(nRow, 1).Value = oMail.Subject
       oWrk.ActiveSheet.Cells(nRow, 2).Value = oMail.Sender.Name
   Next
 
   oWrk.Save
   oWrk.Close
   oExl.Quit
   Set oExl = Nothing
   Set oNs = Nothing
 
   WriteEMailSubjectToExcel = S_OK
End Function