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.
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
Hallo,
Zitatob - 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 (http://www.vboffice.net/sample.html?pub=5&smp=46&cmd=list&mnu=2)
HTH
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
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
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!
ZitatIch 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!
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.
Hallo,
stelle bitte mal fest welchen Wert 'Eingangsbox.Items.Count' ergibt.
Zitat von: database am Mai 27, 2011, 11:29:30
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!
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!
Set OExplorer = OutlN.Application.ActiveExplorer
Set OSelection = OExplorer.Selection
Set OItem = OSelection.Item(IntMailZ)
Hallo,
vermutlich falsche Referenzierungen.
Dieser Code läuft bei mir (Off2003,Win XP):
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
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!
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).
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
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
.
.
.
Hallo Franz,
dankeschön!
Damit funktioniert es!
Das Array-Problem ist trotz abgeschalteter Errorhandler auch nicht mehr aufgetaucht :)