collapse

* Benutzer Info

 
 
Willkommen Gast. Bitte einloggen oder registrieren. Haben Sie Ihre Aktivierungs E-Mail übersehen?

* Wer ist Online

  • Punkt Gäste: 136
  • Punkt Versteckte: 0
  • Punkt Mitglieder: 1
  • Punkt Benutzer Online:

* Forenstatistik

  • stats Mitglieder insgesamt: 14471
  • stats Beiträge insgesamt: 72212
  • stats Themen insgesamt: 9746
  • stats Kategorien insgesamt: 5
  • stats Boards insgesamt: 17
  • stats Am meisten online: 415

Autor Thema: Kennzeichnungsstatus in Outlook über Access ändern  (Gelesen 9536 mal)

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Kennzeichnungsstatus in Outlook über Access ändern
« am: April 21, 2011, 11:19:52 »
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
« Letzte Änderung: April 21, 2011, 17:58:46 von liederstern »
Viele Grüße,
Nicole
 

database

  • Gast
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #1 am: April 23, 2011, 12:49:09 »
Hallo,

Zitat
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
 

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #2 am: Mai 26, 2011, 10:34:34 »
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
Viele Grüße,
Nicole
 

database

  • Gast
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #3 am: Mai 26, 2011, 21:45:02 »
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!

Zitat
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!
« Letzte Änderung: Mai 26, 2011, 21:47:24 von database »
 

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #4 am: Mai 27, 2011, 08:22:42 »
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.
Viele Grüße,
Nicole
 

database

  • Gast
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #5 am: Mai 27, 2011, 11:29:30 »
Hallo,

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

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #6 am: Mai 31, 2011, 10:11:44 »
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!
Viele Grüße,
Nicole
 

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #7 am: Juni 09, 2011, 12:57:40 »
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)
Viele Grüße,
Nicole
 

Offline DF6GL

  • Global Moderator
  • Access-Oberguru
  • *****
  • Beiträge: 23813
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #8 am: Juni 09, 2011, 13:51:51 »
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

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #9 am: Juni 09, 2011, 16:04:26 »
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!
Viele Grüße,
Nicole
 

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #10 am: Juni 10, 2011, 11:50:55 »
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
« Letzte Änderung: Juni 10, 2011, 12:10:30 von liederstern »
Viele Grüße,
Nicole
 

Offline DF6GL

  • Global Moderator
  • Access-Oberguru
  • *****
  • Beiträge: 23813
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #11 am: Juni 10, 2011, 17:06:07 »
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

.
.
.

Offline liederstern

  • Access-User
  • *
  • Beiträge: 88
Re: Kennzeichnungsstatus in Outlook über Access ändern
« Antwort #12 am: Juni 14, 2011, 08:26:10 »
Hallo Franz,
dankeschön!
Damit funktioniert es!
Das Array-Problem ist trotz abgeschalteter Errorhandler auch nicht mehr aufgetaucht :)
Viele Grüße,
Nicole
 

 


Advertisment / Werbung - Amazon Affiliate Links