Kennzeichnungsstatus in Outlook über Access ändern

[liederstern]

Hallo Community,

ich grüble daran, wie - und vielleicht auch eher ob - man den Kennzeichnungsstatus (bunte Fähnchen, erledigt-Häkchen / Flagstatus) einer Mail in Outlook ändern kann..
Sinn der gesamten Programmierung ist, Mails im Posteingang zu finden, die einen bestimmten Dateianhang haben, den Dateianhang im Laufwerk zu speichern und eine Eingangsliste zu führen. Das habe ich auch weitestgehend hinbekommen.
Ich möchte nur nach diesen Schritten die Mail in Outlook auf den Status "gelesen" setzen und den Kennzeichungsstatus auf "erledigt" setzen.
Geht das? Und wenn ja, wie?

Dankeschön!

Der Code ist lediglich informativ. Case 2 wird quasi genauso aussehen wie Case 1.

Code [Auswählen] Erweitern

Sub MailsÜbernehmen()

On Error GoTo Errorhandler

   'On Error GoTo EingangsMailsAusOutlookÜbernehmen_Err

   Dim OutlN As New Outlook.Application
   Dim Eingangsbox As Object
   Dim objKon As Object
   Dim DBS As Recordset
   Dim Conn As Database
   Dim IntMailZ As Integer
   Dim jetzt As Date
   Dim letzteMailvon As Date
   Dim AnhangName As String
   Dim j As Integer
   Dim k As Integer
   Dim Speicherort As String
   Dim importierteMails As Integer 'Variable, die für die Select-Anweisung bestimmen soll, ob alle Mails ausgelesen werden oder ab welchem Datum
   
   MsgBox "Es werden alle Mails aus Outlook ausgelesen, die eine (oder mehrere) txt-Datei/en im Anhang haben " & vbCrLf & _
           "die den Namenskonventionen entspricht" & vbCrLf & _
           "(23- oder 28-stelliger Dateiname, Unterstriche und Bindestrich an den richtigen Positionen)." & vbCrLf & vbCrLf & _
           "Alle anderen txt-Dateien müssen manuell verarbeitet werden." '& vbCrLf & vbCrLf & _
           '"ACHTUNG!!!" & vbCrLf & _
           '"Outlook muss geöffnet sein, damit die Mails verarbeitet werden können."
   
   Set Conn = CurrentDb

   Set DBS = Conn.OpenRecordset("abS_Datenlieferungen_Maileingang", dbOpenDynaset)

   IntMailZ = 0
   jetzt = Now()
   letzteMailvon = DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")
   Debug.Print letzteMailvon
   
   If letzteMailvon = "00:00:00" Then 'wenn Tabelle abs_Datenlieferungen_Maileingang leer ist
       importierteMails = 1
   Else
       importierteMails = 2
   End If
   
   Set Eingangsbox = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) '.Folders("Postfach - Schulen, Ausbildung")
       
       
       Select Case importierteMails
       
           Case 1
           
               For IntMailZ = 1 To Eingangsbox.Items.Count
   
                   Set objKon = Eingangsbox.Items(IntMailZ)

                   'wenn Mail Anhänge hat, nicht erledigt und ungelesen ist, alle Mails in die Tabelle schreiben
                   If objKon.Attachments.Count > 0 And objKon.FlagStatus = 0 And objKon.UnRead = True Then
           
                       'Durchlauf für jeden einzelnen Mailanhang
                       For j = 1 To Eingangsbox.Items(IntMailZ).Attachments.Count
               
                           'On Error GoTo AnhangNameErrHandler
               
                           AnhangName = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(IntMailZ).Attachments(j).FileName
                           'Debug.Print AnhangName
   
                           If (Len(AnhangName) = 28 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 20, 1) = "-" And Mid(AnhangName, 26, 3) = "txt") Or _
                           (Len(AnhangName) = 23 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 21, 3) = "txt") Then
           
                               Speicherort = DLookup("Speicherort", "x_Tabellenverweise", "ID = 7") & "\" & AnhangName
                               'Debug.Print Speicherort
                   
                               Eingangsbox.Items(IntMailZ).Attachments(j).SaveAsFile Speicherort
               
                               With objKon

                                   DBS.AddNew
                                   DBS!Betreff = .Subject
                                   DBS!Empfänger = .To
                                   DBS!Absender = .SenderName
                                   DBS!Eingangsdatum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm:ss")
                                   DBS!Größe = .Size
                                   DBS!Inhalt = .Body
                                   DBS!Abrufzeit = jetzt
                                   DBS!Dateiname = AnhangName

                               End With

                               DBS.Update

                               Speicherort = ""
                   
                           End If
                           
                       Next j
               
                   End If
                   
                   'Set objKon.FlagStatus = 1
                   
               Next IntMailZ
           
           
           Case 2
           'nur die Mail-Anhänge in die Tabelle schreiben, die seit dem letzten Mal neu eingegangen sind
           
       
           End Select
                 

DoCmd.OpenTable "abS_Datenlieferungen_Maileingang"

'AnhangNameErrHandler:
'    Select Case Err.Number
'        Case -2147467259
'         Resume Next
'    End Select
   
Errorhandler:
Select Case Err.Number
   Case 94
       Resume Next
End Select

[database]

Hallo,

ob - man den Kennzeichnungsstatus (bunte Fähnchen, erledigt-Häkchen / Flagstatus) einer Mail in Outlook ändern kann..

sollte eigentlich machbar sein....

du kannst versuchen, dich da mal schlau zu machen..
http://www.vboffice.net/sample.html?pub=5&smp=46&cmd=list&mnu=2

HTH

[liederstern]

hallo Peter
und danke schon einmal für den Hinweis.
Zwar denke ich, dass ich jetzt die richtigen Anweisungen zusammen habe, aber ich erhalte bei jedem Start der Funktion einen Lauftzeitfehler "Array-Index außerhalb des zulässigen Bereichs" mit unterschiedlichsten Fehlernummern (mal -832438263, -763232247, -694026321, -555614199, etc.) in der Zeile Set OItem = OSelection.Item(IntMailZ).
Leider finde ich über google nichts, was mich mit diesen Fehlernummern weiterbringt.
Kann mir jemand weiterhelfen?
Ich muss gestehen, ich weiß nicht, was ein Array ist und stecke deshalb total fest....

ich danke Euch!

"Case 2" entspricht "Case 1" - daher habe ich Case 2 hier rausgelöscht

Code [Auswählen] Erweitern

Sub MailsÜbernehmen()

'On Error GoTo Errorhandler

    'On Error GoTo EingangsMailsAusOutlookÜbernehmen_Err

    Dim OutlN As New Outlook.Application
    Dim Eingangsbox As Object
    Dim objKon As Object
    Dim DBS As Recordset
    Dim Conn As Database
    Dim IntMailZ As Integer
    Dim jetzt As Date
    Dim letzteMailvon As Date
    Dim AnhangName As String
    Dim j As Integer
    Dim k As Integer
    Dim Speicherort As String
    Dim importierteMails As Integer 'Variable, die für die Select-Anweisung bestimmen soll, ob alle Mails ausgelesen werden oder ab welchem Datum
    Dim ersteMaildesAbrufs As Integer
    Dim OExplorer As Outlook.Explorer
    Dim OSelection As Outlook.Selection
    Dim OItem As Object
   
    MsgBox "Es werden alle Mails aus Outlook ausgelesen, die" & vbCrLf & _
           "- ungelesen sind," & vbCrLf & _
           "- kein Häkchen bei 'erledigt' haben und" & vbCrLf & _
           "- eine (oder mehrere) txt-Datei/en im Anhang haben, " & vbCrLf & _
           "- die den Namenskonventionen entsprechen" & vbCrLf & _
           "(23- oder 28-stelliger Dateiname, Unterstriche und Bindestrich an den richtigen Positionen)." & vbCrLf & vbCrLf & _
           "Alle anderen txt-Dateien müssen manuell verarbeitet werden." '& vbCrLf & vbCrLf & _
           '"ACHTUNG!!!" & vbCrLf & _
           '"Outlook muss geöffnet sein, damit die Mails verarbeitet werden können."

    Set Conn = CurrentDb

    Set DBS = Conn.OpenRecordset("abS_Datenlieferungen_Maileingang", dbOpenDynaset)

    IntMailZ = 0
    jetzt = Now()

    If IsNull(DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")) = True Then 'wenn Tabelle abs_Datenlieferungen_Maileingang leer ist
        importierteMails = 1
    Else
        letzteMailvon = DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")
        importierteMails = 2
    End If


    Set Eingangsbox = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) '.Folders("Postfach - Schulen, Ausbildung")


        Select Case importierteMails

            Case 1

                For IntMailZ = 1 To Eingangsbox.Items.Count

                    Set objKon = Eingangsbox.Items(IntMailZ)

                    'wenn Mail Anhänge hat, nicht erledigt und ungelesen ist, alle Mails in die Tabelle schreiben
                    If objKon.Attachments.Count > 0 And objKon.FlagStatus = 0 And objKon.UnRead = True Then

                        'Durchlauf für jeden einzelnen Mailanhang
                        For j = 1 To Eingangsbox.Items(IntMailZ).Attachments.Count

                            On Error GoTo AnhangNameErrHandler

                            AnhangName = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(IntMailZ).Attachments(j).FileName
                            Debug.Print AnhangName

                            If (Len(AnhangName) = 28 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 20, 1) = "-" And Mid(AnhangName, 26, 3) = "txt") Or _
                            (Len(AnhangName) = 23 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 21, 3) = "txt") Then

                                Speicherort = DLookup("Speicherort", "x_Tabellenverweise", "ID = 7") & "\" & AnhangName
                                Debug.Print Speicherort

                                Eingangsbox.Items(IntMailZ).Attachments(j).SaveAsFile Speicherort

                                With objKon

                                    DBS.AddNew
                                    DBS!Betreff = .Subject
                                    DBS!Empfänger = .To
                                    DBS!Absender = .SenderName
                                    DBS!Eingangsdatum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm:ss")
                                    DBS!Größe = .Size
                                    DBS!Inhalt = .Body
                                    DBS!Abrufzeit = jetzt
                                    DBS!Dateiname = AnhangName

                                End With

                                If ersteMaildesAbrufs = 0 Then
                                    With objKon
                                        DBS!Marker = "x"
                                    End With
                                    ersteMaildesAbrufs = 1
                                End If

                                DBS.Update

                                Speicherort = ""

                            End If

                        Next j

                        'Kennzeichnungsstatus der Mail auf erledigt und Mail auf gelesen setzen
                        Set OExplorer = OutlN.Application.ActiveExplorer
                        Set OSelection = OExplorer.Selection
                        Set OItem = OSelection.Item(IntMailZ)

                        With OItem
                            .FlagStatus = 1
                            .UnRead = False
                        End With

                    End If

                Next IntMailZ


            Case 2
            'nur die Mail-Anhänge in die Tabelle schreiben, die seit dem letzten Mal neu eingegangen sind


            End Select


DoCmd.OpenTable "abS_Datenlieferungen_Maileingang"

AnhangNameErrHandler:
    Select Case Err.Number
        Case -2147467259
            Resume Next
        Case Is <> -2147467259
            Resume Next
    End Select

'Errorhandler:
'Select Case Err.Number
'    Case 94
'        Resume Next
'End Select

End Sub

[database]

Hallo,

von wievielen Mails ungefähr sprechen wir denn?

wenn Case 1 gleich ist wie Case 2 ... wozu unterscheidest du dann?

Die On Error Anweisung sollte schon am Anfang der Prozedur stehen und nicht irgenwo in der Mitte!
und schränk die Fehlerbehandlung nicht ein - nimm statt dessen

Msgbox Err.Number & vbcrlf & Err.Description

So wie du die Fehlerbehandlung gestrickt hast wird der Code ausgeführt egal was passiert!

Ich muss gestehen, ich weiß nicht, was ein Array ist und stecke deshalb total fest

Bitte nicht böse sein - ich weiß jede(r) fängt mal an - aber GRUNDBEGRIFFE sind schon von Vorteil, wenn man einen derart komplexen Code beherrschen möchte.
Das ist ja kein Spaziergang, da geht's schon ein bissl ins Eingemachte!

[liederstern]

Hallo Peter,

wir sprechen von ca. 1000 Mails mit einer bis ca. fünf txt-Dateien im Anhang, die bei uns eingehen werden. Da es sich hierbei aber um unser ganz normales Postfach handelt, gehen dort natürlich auch gewöhnliche Mails ein, die aber für die weitere Verarbeitung, die sich an den für mich problematischen Code anschließt, nicht weiter interessieren.
Sinn des ganzen ist, die txt-Dateien auf unserem Laufwerk zu speichern und die entsprechende Mail auf erledigt und gelesen zu setzen (dieser Code) und dann in einer Eingangsliste zu führen (schon bestehender Code), damit dies nicht mehr von Hand geschehen muss.
Case1 und Case2 werden sich schon unterscheiden, aber so minimal, dass ich mit der zusätzlichen Menge an Code nicht noch mehr verwirren wollte.
Dass der unten eingefügte AnhangNameErrHandler so unsinnig ist, ja, stimmt. Ich hatte vergessen ihn vor dem Kopieren wieder zurückzusetzen.
Habe dort jetzt Deinen Vorschlag Msgbox Err.Number & vbcrlf & Err.Description eingebaut. Danke schon mal für den Hinweis.

[database]

Hallo,

stelle bitte mal fest welchen Wert 'Eingangsbox.Items.Count' ergibt.

[liederstern]

stelle bitte mal fest welchen Wert 'Eingangsbox.Items.Count' ergibt.

Hallo Peter,
konnte es leider jetzt erst wieder im Büro testen
Der Wert ist 185.

Danke für's Kümmern!

[liederstern]

Hallo zusammen,

komme von dieser Geschichte ja immer noch nicht los.
Er fliegt bei "Set OItem" raus, landet also im Errorhandler mit dem besagte Array-Problem.
Wenn ich während der schrittweisen Ausführung die drei unten genannten "Variablen" auswähle - oder besser den TipText anzeigen lasse - steht in allen drei Fällen immer nur "..=Nothing".
Aber wieso sind die Werte leer?
Kann mir jemand helfen, bitte?
Danke!

Code [Auswählen] Erweitern

                                Set OExplorer = OutlN.Application.ActiveExplorer
                                Set OSelection = OExplorer.Selection
                                Set OItem = OSelection.Item(IntMailZ)

[DF6GL]

Hallo,


vermutlich falsche Referenzierungen.



Dieser Code läuft bei mir (Off2003,Win XP):

Code [Auswählen] Erweitern

Sub MailsÜbernehmen()

'On Error GoTo Errorhandler

   'On Error GoTo EingangsMailsAusOutlookÜbernehmen_Err

   Dim OutlN As New Outlook.Application
   Dim Eingangsbox As Object
   Dim objKon As Object
   Dim DBS As Dao.Recordset   'DAO explizit Referenzieren
   Dim Conn As Database
   Dim IntMailZ As Long  'Integer vermeiden, Long verwenden
   Dim jetzt As Date
   Dim letzteMailvon As Date
   Dim AnhangName As String
   Dim j As Long
   Dim k As Long
   Dim Speicherort As String
   Dim importierteMails As Integer 'Variable, die für die Select-Anweisung bestimmen soll, ob alle Mails ausgelesen werden oder ab welchem Datum
   Dim ersteMaildesAbrufs As Long
   Dim OExplorer As Outlook.Explorer
   Dim OSelection As Outlook.Selection
   Dim OItem As Object
   
   MsgBox "Es werden alle Mails aus Outlook ausgelesen, die" & vbCrLf & _
          "- ungelesen sind," & vbCrLf & _
          "- kein Häkchen bei 'erledigt' haben und" & vbCrLf & _
          "- eine (oder mehrere) txt-Datei/en im Anhang haben, " & vbCrLf & _
          "- die den Namenskonventionen entsprechen" & vbCrLf & _
          "(23- oder 28-stelliger Dateiname, Unterstriche und Bindestrich an den richtigen Positionen)." & vbCrLf & vbCrLf & _
          "Alle anderen txt-Dateien müssen manuell verarbeitet werden." '& vbCrLf & vbCrLf & _
          '"ACHTUNG!!!" & vbCrLf & _
          '"Outlook muss geöffnet sein, damit die Mails verarbeitet werden können."

   Set Conn = CurrentDb

   Set DBS = Conn.OpenRecordset("abS_Datenlieferungen_Maileingang", dbOpenDynaset)

   IntMailZ = 0
   jetzt = Now()

   If IsNull(DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")) = True Then 'wenn Tabelle abs_Datenlieferungen_Maileingang leer ist
       importierteMails = 1
   Else
       letzteMailvon = DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")
       importierteMails = 2
   End If


    Set Eingangsbox = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Postfach - Schulen, Ausbildung")   'falls der Posteingang-Unterordner tatsächlich so heißt

       Select Case importierteMails

           Case 1

               For IntMailZ = 1 To Eingangsbox.Items.Count

                   Set objKon = Eingangsbox.Items(IntMailZ)

                   'wenn Mail Anhänge hat, nicht erledigt und ungelesen ist, alle Mails in die Tabelle schreiben


             '      If objKon.Attachments.Count > 0 And objKon.FlagStatus = 0 And objKon.UnRead = True Then
If objKon.Attachments.Count > 0  Then    ' obige Zusatz-Bedingung nicht getestet.


                       'Durchlauf für jeden einzelnen Mailanhang
                       For j = 1 To Eingangsbox.Items(IntMailZ).Attachments.Count

                           On Error GoTo AnhangNameErrHandler

                          AnhangName = Eingangsbox.Items(IntMailZ).Attachments(j).Filename    '  auf richtigen Folder referenziert


                           Debug.Print AnhangName

                         '  If (Len(AnhangName) = 28 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 20, 1) = "-" And Mid(AnhangName, 26, 3) = "txt") Or _
                           (Len(AnhangName) = 23 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 21, 3) = "txt") Then

If True Then  ' obige Bedingung nicht getestet



                               Speicherort = DLookup("Speicherort", "x_Tabellenverweise", "ID = 7") & "\" & AnhangName
                               Debug.Print Speicherort

                               Eingangsbox.Items(IntMailZ).Attachments(j).SaveAsFile Speicherort

                               With objKon

                                   DBS.AddNew
                                   DBS!Betreff = .Subject
                                   DBS!Empfänger = .To
                                   DBS!Absender = .SenderName
                                   DBS!Eingangsdatum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm:ss")
                                   DBS!Größe = .Size
                                   DBS!Inhalt = .Body
                                   DBS!Abrufzeit = jetzt
                                   DBS!Dateiname = AnhangName

                               End With

                               If ersteMaildesAbrufs = 0 Then
                                   With objKon
                                       DBS!Marker = "x"
                                   End With
                                   ersteMaildesAbrufs = 1
                               End If

                               DBS.Update

                               Speicherort = ""

                           End If

                       Next j

                       'Kennzeichnungsstatus der Mail auf erledigt und Mail auf gelesen setzen
                       Set OExplorer = OutlN.Application.ActiveExplorer
                       Set OSelection = OExplorer.Selection
                       Set OItem = OSelection.Item(IntMailZ)

                       With OItem
                           .FlagStatus = 1
                           .UnRead = False
                       End With

                   End If

               Next IntMailZ


           Case 2
           'nur die Mail-Anhänge in die Tabelle schreiben, die seit dem letzten Mal neu eingegangen sind


           End Select


DoCmd.OpenTable "abS_Datenlieferungen_Maileingang"
  Exit Sub   

'Errorhandler nicht getestet

AnhangNameErrHandler:
   Select Case Err.Number
       Case -2147467259
           Resume Next
       Case Is <> -2147467259
           Resume Next
   End Select

'Errorhandler:
'Select Case Err.Number
'    Case 94
'        Resume Next
'End Select

End Sub

[liederstern]

Hallo Franz
und danke schon einmal für Deine Mühe!
Du hast völlig Recht - Dein Code läuft.
Ich werde morgen meine Bedingungen wieder einsetzen (prüfen auf txt-Dateien etc.) und dann noch mal prüfen, wo ich noch auf Grund laufe.
Ich hoffe, ich darf mich dann noch mal melden...(?)
Aber schon mal ein großes DANKE an Dich!

[liederstern]

Hallo zusammen,
hallo Franz,

Dein Code funktioniert, ja, aber der Errorhandler war ja auch dummerweise von mir so eingestellt, dass jedes Problem durchgewunken wird...
Den Array-Fehler bekomme ich immer noch und vermutlich deshalb, weil er nicht die Mail als gelesen und mit einem Fähnchen markiert, deren Dateianhänge er gerade weggespeichert hat, sondern er markiert lediglich die Mail, die in Outlook zufälligerweise angeklickt, also ausgewählt ist. Das kann eine Mail im Posteingang oder in den Gesendeten Mails sein (weitere habe ich nicht getestet).
Gemerkt habe ich es beim schrittweisen Durchlaufen der 3 Set-Anweisungen, da OItem die Betreffzeile der Outlook ausgewählten Mail zeigt.#
Meine Vermutung ist also, dass er nicht die z.B. 33. Mail im Posteingang mit einem Fähnchen markieren will, sondern die 33. ausgewählte Mail, die es natürlich nicht gibt...
Wie also bewege ich Outlook dazu, eine konkrete Mail anhang von IntMailZ zu selektieren?
Das mit dem Fähnchen etc. scheint ja generell zu funktionieren - nur eben bei der falschen Mail....
Kann mir jemand einen Tipp geben?
Danke!


Anbei mein aktueller Code (mit den Verbesserungen von Franz plus den mit zwischenzeitlichen Änderungen von mir).

Code [Auswählen] Erweitern

Sub MailsÜbernehmen()

'On Error GoTo Errorhandler

   'On Error GoTo EingangsMailsAusOutlookÜbernehmen_Err

   Dim OutlN As New Outlook.Application
   Dim Eingangsbox As Object
   Dim objKon As Object
   Dim DBS As DAO.Recordset   'DAO explizit Referenzieren
   Dim Conn As Database
   Dim IntMailZ As Long  'Integer vermeiden, Long verwenden
   Dim jetzt As Date
   Dim letzteMailvon As Date
   Dim AnhangName As String
   Dim j As Long
   Dim Speicherort As String
   Dim importierteMails As Integer 'Variable, die für die Select-Anweisung bestimmen soll, ob alle Mails ausgelesen werden oder ab welchem Datum
   Dim ersteMaildesAbrufs As Long
   Dim OExplorer As Object 'Outlook.Explorer
   Dim OSelection As Object 'Outlook.Selection
   Dim OItem As Object
   
   MsgBox "Es werden alle Mails aus Outlook ausgelesen, die" & vbCrLf & _
          "- ungelesen sind," & vbCrLf & _
          "- kein Häkchen bei 'erledigt' haben und" & vbCrLf & _
          "- eine (oder mehrere) txt-Datei/en im Anhang haben, " & vbCrLf & _
          "- die den Namenskonventionen entsprechen" & vbCrLf & _
          "(23- oder 28-stelliger Dateiname, Unterstriche und Bindestrich an den richtigen Positionen)." & vbCrLf & vbCrLf & _
          "Alle anderen txt-Dateien müssen manuell verarbeitet werden." '& vbCrLf & vbCrLf & _
          '"ACHTUNG!!!" & vbCrLf & _
          '"Outlook muss geöffnet sein, damit die Mails verarbeitet werden können."

   Set Conn = CurrentDb

   Set DBS = Conn.OpenRecordset("abS_Datenlieferungen_Maileingang", dbOpenDynaset)

   IntMailZ = 0
   jetzt = Now()

   If IsNull(DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")) = True Then 'wenn Tabelle abs_Datenlieferungen_Maileingang leer ist
       importierteMails = 1
   Else
       letzteMailvon = DMax("Eingangsdatum", "abS_Datenlieferungen_Maileingang")
       importierteMails = 2
   End If

   Set Eingangsbox = OutlN.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

       Select Case importierteMails

           Case 1

               For IntMailZ = 1 To Eingangsbox.Items.Count

                   Set objKon = Eingangsbox.Items(IntMailZ)

                   'wenn Mail Anhänge hat, nicht erledigt und ungelesen ist, alle Mails in die Tabelle schreiben
                   'If objKon.Attachments.Count > 0 And objKon.FlagStatus = 0 And objKon.UnRead = True Then
                   
If objKon.Attachments.Count > 0 Then     ' obige Zusatz-Bedingung nicht getestet.

                       'Durchlauf für jeden einzelnen Mailanhang
                       For j = 1 To Eingangsbox.Items(IntMailZ).Attachments.Count

                       'On Error GoTo AnhangNameErrHandler

                           AnhangName = Eingangsbox.Items(IntMailZ).Attachments(j).FileName    '  auf richtigen Folder referenziert

                           If Right(AnhangName, 3) <> "txt" Then GoTo Zeile1
                           
                           Debug.Print AnhangName
                           
'                            If (Len(AnhangName) = 28 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 20, 1) = "-" And Mid(AnhangName, 26, 3) = "txt") Or _
'                            (Len(AnhangName) = 23 And Mid(AnhangName, 1, 2) = "07" And Mid(AnhangName, 8, 1) = "_" And Mid(AnhangName, 11, 1) = "_" And Mid(AnhangName, 21, 3) = "txt") Then

If True Then  ' obige Bedingung nicht getestet
                               Speicherort = DLookup("Speicherort", "x_Tabellenverweise", "ID = 7") & "\" & AnhangName
                               Debug.Print Speicherort

                               Eingangsbox.Items(IntMailZ).Attachments(j).SaveAsFile Speicherort

                               With objKon

                                   DBS.AddNew
                                   DBS!Betreff = .Subject
                                   DBS!Empfänger = .To
                                   DBS!Absender = .SenderName
                                   DBS!Eingangsdatum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm:ss")
                                   DBS!Größe = .Size
                                   DBS!Inhalt = .Body
                                   DBS!Abrufzeit = jetzt
                                   DBS!Dateiname = AnhangName

                               End With

                               If ersteMaildesAbrufs = 0 Then
                                   With objKon
                                       DBS!Marker = "x"
                                   End With
                                   ersteMaildesAbrufs = 1
                               End If

                               DBS.Update

                               Speicherort = ""
                               
                               
                               If j = Eingangsbox.Items(IntMailZ).Attachments.Count Then

                                   'Kennzeichnungsstatus der Mail auf erledigt und Mail auf gelesen setzen
                                   
                                   Set OItem = Nothing
                                   Set OExplorer = OutlN.Application.ActiveExplorer
                                   Set OSelection = OExplorer.Selection
                                   Set OItem = OSelection.Item(IntMailZ)

                                   With OItem
                                       .FlagStatus = 1
                                       .UnRead = False
                                   End With

                               End If
                           
                           End If
                                                 
Zeile1:
                       Next j

                   End If

               Next IntMailZ


           Case 2
           'nur die Mail-Anhänge in die Tabelle schreiben, die seit dem letzten Mal neu eingegangen sind


           End Select


DoCmd.OpenTable "abS_Datenlieferungen_Maileingang"
 Exit Sub

'Errorhandler nicht getestet

AnhangNameErrHandler:
   Select Case Err.Number
       Case -2147467259
           Resume Next
       Case Is <> -2147467259
           MsgBox Err.Number & vbCrLf & Err.Description
   End Select

'Errorhandler:
'Select Case Err.Number
'    Case 94
'        Resume Next
'End Select

End Sub

[DF6GL]

Hallo,

dann bezieh Dich halt auf die akt. bearbeitete Email (auch wieder unchecked):



.
.
.
  DBS.Update                               
Speicherort = ""     
                                                                                           
If j = Eingangsbox.Items(IntMailZ).Attachments.Count Then                                   
'Kennzeichnungsstatus der Mail auf erledigt und Mail auf gelesen setzen                                                                       
Set OItem = Nothing                                   
Set OExplorer = OutlN.Application.ActiveExplorer                                   
Set OSelection = OExplorer.Selection                                   
Set OItem = OSelection.Item(IntMailZ)                                   
With OItem                                       
.FlagStatus = 1                                       
.UnRead = False                                   
End With                               
End If

With Eingangsbox.Items(IntMailZ)
.FlagStatus = 1                                       
.UnRead = False 
End With
.
.
.

[liederstern]

Hallo Franz,
dankeschön!
Damit funktioniert es!
Das Array-Problem ist trotz abgeschalteter Errorhandler auch nicht mehr aufgetaucht