Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)

Public Sub Email_To_HDD(ByVal sPath As String, Erweiterung As String)
  On Error GoTo error_handler
 
  Dim strStatus As String
  strStatus = "Variablen-Definition"
  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 oDestFolder As Object    ' ZielFolder für Outlook Mail
  Dim i As Integer
  Dim j As Integer
  Dim blnSaveAtt As Boolean
 
  ' Outlook-Konstanten
  strStatus = "Konstanten-Definition"
  Const olFolderInbox = 6
  Const olTXT = 0
 
  strStatus = "Attachement Speicherort bestimmen"
  ' Ggf. abschließenden Backslash entfernen
  If Right$(sPath, 1) = "\" Then
    sPath = Left$(sPath, Len(sPath) - 1)
  End If
 
  ' Falls Zielordner nicht existiert,
  ' jetzt erstellen
  strStatus = "Attachement Speicherort ggf. erstellen"
  If Dir$(sPath, vbDirectory + vbHidden) = "" Then
    MkDir sPath
  End If
 
  ' Outlook-Objekt erstellen
  strStatus = "Objekt fuer Outlook erstellen"
  Set oOutlook = CreateObject("Outlook.Application")
 
  ' Namespace: MAPI
  strStatus = "Typ ist MAPI"
  Set oNamespace = oOutlook.GetNamespace("MAPI")
 
  ' Outlook-Ordner: "Neue Nachrichten"
  strStatus = "Posteingang fuer neue Nachrichten"
  Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
 
  ' Alle Mails durchlaufen
  strStatus = "Alle Mails durchlaufen"
  i = 1
  j = oFolder.Items.Count
  Do While j > 0
    blnSaveAtt = False
    Set oMail = oFolder.Items(j)
 
    ' Auf Anhang prüfen und evtl. speichern
    With oMail.Attachments
      i = .Count
      Do While (i > 0)
        Set oAnhang = .Item(i)
 
        ' Anhang unter entsprechendem Namen speichern.
        ' Das "i_" ist nur zur Sicherheit, um doppelte
        ' Dateinamen zu verhindern
        If blnCheck_FileExt(oAnhang.DisplayName, Erweiterung) = True Then
          strStatus = "Anhang gefunden und speichern nach " & sPath & "\" & _
            oMail.SenderName & "_" & oAnhang.DisplayName
          'oAnhang.SaveAsFile sPath & "\" & CStr(i) & "_" & _
          oAnhang.DisplayName
 
          oAnhang.SaveAsFile sPath & "\" & oMail.SenderName & "_" & _
            oAnhang.DisplayName
          blnSaveAtt = True
        End If
        i = i - 1
      Loop
    End With
 
    'eingefügt am 19.10.05, wenn eine Mail gelöscht oder verschoben werden soll
    If blnSaveAtt Then
      strStatus = "Mail wird weiterverarbeitet nach der festgelegten Methode: " _
        & strMailStatus
      Select Case UCase(strMailStatus)
        Case UCase("DeleteMail"): oMail.Delete
        Case UCase("MoveMail")
          ' Outlook Unterordner festlegen
          Set oDestFolder = oFolder.Folders(strMailFolder)
          oMail.Move oDestFolder
        Case UCase("LeaveMail"):
        Case Else
          'MsgBox "Falscher Parameter in Parameter-Datei angegeben", vbCritical
          Form1.NTService1.LogEvent svcEventError, svcMessageError, _
            Err.Description & " - Email_To_HDD - Falscher Parameter (" & _
            "DeleteMail, MoveMail, LeaveMail)"
      End Select
    End If
 
    j = j - 1
  Loop
 
  ' Fertig
  'MsgBox "Done"
 
  ' Objekte zerstören
  strStatus = "Mailobjekte zerstören"
  Set oMail = Nothing
  Set oAnhang = Nothing
  Set oFolder = Nothing
  Set oNamespace = Nothing
  Set oOutlook = Nothing
  Exit Sub
 
error_handler:
 Form1.NTService1.LogEvent svcEventError, svcMessageError, Err.Description & _
 " - Email_To_HDD - Email Attachement Export Fehler an der Stelle " & strStatus _
 & " - "
 Set oMail = Nothing
 Set oAnhang = Nothing
 Set oFolder = Nothing
 Set oNamespace = Nothing
 Set oOutlook = Nothing
 
End Sub