Private Sub TimerAktuell_Timer()
 
    TimerAktuell.Enabled = False
    DoMailCheck
    TimerAktuell.Enabled = True
 
End Sub
 
 
Sub DoMailCheck()
  Dim lngMsgCount As Long
  Dim lngSize As Long
  Dim lngIndex As Long
  Dim oHeader As sevMailActiveX.HeaderInfo
  Dim oRS As Recordset
  Dim sTempPfad As String
  Dim sIndexOrdner As String
  Dim sFile As String
  Dim oMessage As New sevMailActiveX.sevMail
  Dim Index As Integer
  Dim sWert() As String
  Dim sDatei As String
 
 
  With frmBasis.sevPOP1
    ' Anmelde-Daten
    .ServerName = GetSetting(sAnwendungsName, "Einstellungen", "POP3")
    .ServerPort = Val(GetSetting(sAnwendungsName, "Einstellungen", "pop3port", _
      110))
    .UserName = GetSetting(sAnwendungsName, "Einstellungen", "Mailuser")
    .Password = Do_Decode(GetSetting(sAnwendungsName, "Einstellungen", _
      "Mailpw"), "????")
    .DeleteFromServer = CBool(GetSetting(sAnwendungsName, "Einstellungen", _
    "DeleteMail", 1))
 
    ' ggf. abmelden
    .Disconnect
 
    ' am POP3-Server anmelden
    Screen.MousePointer = vbHourglass
 
    If Not .Connect() Then
      ' Fehler bei der Anmeldung!
      txtStatus = "Fehler: " & .POP3ErrorText & ", " & .LastResponse
    Else
 
      ' Sind neue Nachrichten vorhanden?
      lngMsgCount = .NewMailsAvailable(lngSize)
      If lngMsgCount > 0 Then
        ' Anzahl Nachrichten + Gesamtgröße
 
        ' Jetzt einzelne Nachrichten-Infos abholen
        sTempPfad = GetSetting(sAnwendungsName, "Einstellungen", "Archiv") & _
          "\E-Mails\" & Year(Date) & ", " & Right("00" & Month(Date), 2) & "\"
 
        For lngIndex = 1 To lngMsgCount
          bInDB = False
 
          sFile = sTempPfad & Format(Now, "yyyymmdd_hhnnss") & "_MAIL_" & _
            lngIndex & ".eml"
 
          Set oHeader = .HeaderInfo(lngIndex)
          If .FetchMail(lngIndex, sFile, .DeleteFromServer) = True Then
              With oHeader
                If InStr(1, .Subject, "Neues Telefax von") > 0 Then
                    'Fax
 
                    If oMessage.OpenMail(sFile) Then
                        ' Anlagen vorhanden?
                        If oMessage.Attachment.AttachCount > 0 Then
                          ' Alle Anlagen unter Originaldateinamen abspeichern
                          For Index = 0 To oMessage.Attachment.AttachCount - 1
                            ' Fortschrittsanzeige: ja
                            If FileExists(Replace(sTempPfad, "\E-Mails\", _
                              "\Faxe\") & oMessage.Attachment.FileName(Index)) _
                              = False Then
                                oMessage.Attachment.Save Replace(sTempPfad, _
                                "\E-Mails\", "\Faxe\") & _
                                oMessage.Attachment.FileName(Index), True, _
                                True, Index
                                sDatei = oMessage.Attachment.FileName(Index)
                                bInDB = True
                            End If
                          Next Index
                        End If
                    End If
 
          	end with
          Else
            'Mailfehler
 
          End If
        Next
      Else
        If .POP3Error <> 0 Then
          ' Fehler!
          Fehlerprotokoll -1, .POP3ErrorText, "DoMailCheck", True
        Else
          ' keine Nachrichten vorhanden
          txtStatus = "Keine Nachrichten vorhanden."
        End If
      End If
    End If
 
    ' Abmelden
    If .POP3Error <> 0 Then .Disconnect
  End With
  Screen.MousePointer = vbNormal
 
End Sub