Outlook 2003: VBscript zum Automatischen Abspeichern von Anlagen funktioniert nicht !

Habe folgendes Problem: Bekomme jeden Tag 3 Mails von AAAA. Diese sollen automatisch abgespeichert werden. Sobald eines der 3 Mails mit einer Anlage mit Datei Namen "synthlp-008-00001*" eintrifft gebe ich zusätzlich eine Meldung aus.

So sehen zum Beispiel die 3 Dateien aus den 3 Mails aus (ein Tag) , Reihenfolge kann variieren:
synthlp-008-00002_0803130959_36357.txt
synthlp-008-00001_0803130959_36365.txt
synthlp-008-00003_0803130959_36349.txt

Nun habe ich das Programm getestet. Und siehe da, manchmal funktioniert es und manchmal nicht.

Test mit 9 Mails:
bekomme nur 2 von 3 Meldungen
abgespeichert werden nur 7 von 9 Dateien

Test mit 3 Mails:
bekomme 1 von 1 Meldung
abgespeichert werden nur 2 von 3 Dateien

Manchmal funktioniert es aber einwandfrei,...

Was kann hier das Problem sein??? Die Reihenfolge der Mails, wie sie eingelangen ist teils unterschiedlich, aber das kann doch nicht das Problem sein???

Nun mein Code:

Code:

[SIZE="2"]Public Sub Application_NewMail()

    Dim Ordnername As String
    Dim OrdnernameOEKO As String
    Dim objPosteingang As MAPIFolder
    Dim objNewMail As MailItem
    
    On Error Resume Next
    Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set myNewFolder = objPosteingang.Folders(6).Folders(1) ' Unterordner
    Set myNewFolderOEKO = objPosteingang.Folders(5) ' Unterordner
    
    Ordnername = "K:\tmp\synth_Gas"
    OrdnernameOEKO = "H:\ALLGMEIN\LS_DATA\Fahrplan\OEKO_FPL"
    For Each objNewMail In objPosteingang.Items
        With objNewMail
        
        'AAAA_SynthLP Mail
        If .Subject = "DATA" And .SenderEmailAddress = "AAAA@data.AAAA.at" Then
            If .Attachments.Count > 0 Then
                If .UnRead = True Then
                    If .Attachments.Item(1).FileName Like "synth*" Then
                        .Attachments.Item(1).SaveAsFile Ordnername & "\" & .Attachments.Item(1).FileName
                        .UnRead = False
                        .Move myNewFolder
                    End If
                    If .Attachments.Item(1).FileName Like "synthlp-008-00001*" Then
                        Set server_shell = CreateObject("wscript.shell")
            server_shell.run "%comspec% /c net send pcXXX.eww.at Neue AAAA_Synth_LP vorhanden", 0, True
            server_shell.run "%comspec% /c net send pcXXX.eww.at Neue AAAA_Synth_LP vorhanden", 0, True
                        server_shell = Null
                    End If
                End If
            End If
        End If
        [/SIZE]
        [I]'ÖKO - Fahrplan FUNKTIONIERT EINWANDFREI[/I]
        [SIZE="1"][I]If .SenderEmailAddress = "a@b.at" Then
            If .Attachments.Count > 0 Then
                If .UnRead = True Then
                    If .Attachments.Item(1).FileName Like "*14XENERGIEAG*" Then
                        .Attachments.Item(1).SaveAsFile OrdnernameOEKO & "\" & .Attachments.Item(1).FileName
                        .UnRead = False
                        .Move myNewFolderOEKO
                        
                        Set objMedia = CreateObject("wscript.shell")
                        
                        datei = "D:\Sound.WAV"
                        objMedia.run "" & datei, 2
                        objMedia.Quit
                        
                        objMedia = Null
                        datei = Null
                        
                        Set objExcel = CreateObject("Excel.Application")
                        Set objWorkbook = objExcel.Workbooks.Open("H:\XXX\Fahrplan.xls")
                        
                        objExcel.Visible = True
                        
                        objExcel.run ("ÖKO_FPL")
                        
                        wscript.sleep 15000
                        
                        objExcel.Quit
                        
                        objExcel = Null
                        objWorkbook = Null
                           
                    End If
                End If
            End If
        End If[/I][/SIZE]
        
        End With
    Next objNewMail
    
    objPosteingang = Null
    myNewFolder = Null
    myNewFolderOEKO = Null
    
    Ordnername = Null
    OrdnernameOEKO = Null
End Sub

Würde mich sehr freuen, wenn mir wer helfen könnte,...

 

Ich habe im Moment keine Zeit das näher anzusehen... später...
...aber es hängt doch nicht etwa mit dem Schreibfehler in der obigen Variablen zusammen?

Der Ordner heisst doch sicher ALLGEMEIN, oder nicht?

Gruss Urs

 

sollte er eigentlich heißen, aber naja,... unsre EDV-ler wollen es nicht wirklich ändern, weil sich dieses Verzeichnis über die ganze Firma zieht,...

der Name passt schon,... wie schon gesagt, das abspeichern für den OEKO-Fahrplan funktioniert e einwandfrei,...

hab nur Probleme mit den besch******* 3 Mails,... sorry, aber schön langsam gehts mich an,....

lg max

 

Ich habe hier einen Script, der in einem Verzeichnis aus 100 Dateien etwas auslesen, damit etwas machen und das Resultat in eine neue Datei speichern soll. Nach etwa 50 Dateien findet er, es sei nun genug getan!

Wenn ich ihn sofort wieder laufen lasse, arbeitet er alle 100 ab > Ich habe nicht die geringste Ahnung warum er das tut.

Zur Strafe muss er nun automatisch die ersten 50 abarbeiten, seine Ausgabe löschen und nochmals von vorn beginnen > Umständlich und unverständlich, aber effizient!

Ich werde später nach Uebereinstimmungen in Deinem und meinem verrückten Script forschen.

Bis bald, Urs

 

Ich habe meinen Script zerlegt und herum geforscht... Deinen kann ich hier nicht replizieren.

Mein Spinner-Script ist ein VBA in Word, mit ForEach und With. Deiner ist zwar ein VBS, das aber dann, wie meiner auch, Office-VBA nutzt. Bei beiden liegt der Fehler im Office-Bereich, und zwar in der Schleife "For Each abc In xyz".

Mein Script listet, im neu gestarteten Word, im ersten Durchgang im Objekt xyz immer nur 19 von 113 vorhandenen Items auf. Im zweiten Durchgang sind es dann alle 113.
Ich vermute stark, dass das Objekt zuerst nicht genug Speicher zugewiesen bekommt, und erst im zweiten Durchgang "weiss", dass mehr Platz nötig ist. Gelegentlich werde ich schauen, wie ich von Beginn weg mehr Speicher zuweisen lassen kann... bis dann läuft er halt einfach zweimal...

Dein Script hat vielleicht den gleichen Zusatzfehler, wenn viele Mails im Posteingang sein sollten. Der Hauptfehler ist aber >

Innerhalb einer For-Each-In-Schleife dürfen keine Elemente aus dem xyz-Objekt gelöscht oder verschoben werden. Das Resultat wird unvorhersehbar (was es bei Dir offenbar ja ist).
Du kannst ja versuchsweise die Zeilen mit Move deaktivieren, und schauen...

Umgehen kann man das mit einer abzählenden For-Schleife. Jedes Mail im Posteingang wird bearbeitet und dann verschoben. Im nächsten Durchgang passiert mit dem nächsten Mail das Gleiche, bis keine mehr da sind.

Da wohl auch andere Mails im Eingang sind, müssen diese provisorisch auch verschoben werden. Nach den For-Schleifen könnte man sie wieder zurückholen...
Dazu würde ich die beiden grossen If-Blöcke mit ElseIf verbinden und am Ende des zweiten Blocks ein Else setzen, um alles nicht Betroffene provisorisch zu verschieben.

Aber vielleicht geht es auch so, ohne die nicht betroffenen Mails zu verschieben >
Das ForEach könnte dann etwa so ersetzt werden

Code:

mCount = objPosteingang.Items.Count
    For i = mCount to 1 Step -1
        Set Item = objPosteingang.Items(i)
        'With
            'Dein Code 
        'End With
    Next

Testen konnte ich das nicht, das überlasse ich Dir...

Gruss Urs

 

erstmal dankeschön,...

jetzt komm ich langsam dahinter, was das Problem sein kann,... und du hast wahrscheinlich recht,...

jetzt hab ich mal die Frage, was denn ist, wenn ich zum Beispiel die For Each schleife durch ein For ersetze, dass immer -sagen wir mal- 10 mal durchläuft,...???

Sprich ungefähr so:

Code:

    For i = 1 to 10 Step +1
        Set Item = objPosteingang.Items(i)
        'With
            'Mein Code 
        'End With
    Next

im Posteingang sind nämlich nie mehr als 3-5 Mails gleichzeitig,... Kann das zu einem Fehler führen???

Es wäre zwar auch keine schöne Lösung, jedoch könnte sie den Zweck erfüllen,...

Da hab ich jetzt noch ne Frage,... die Mails kommen mit jeweils ein paar Sekunden dazwischen,... Wenn das Script läuft und während dem Ablauf kommt zum Beispiel das 3. Mail,... dann ist das doch auch so ein Fall,... da nimmt er mir dann das 3. Mail nicht mehr,...
Da fällt mir ein,... kann ich das Script "schlafen" legen,... hab schon einiges herumgeschmökert,... jedoch so wie ich mir das vorstelle bzw. wie ich es eingebaut habe funktioniert das nicht ganz,...
sleep? wait??

Ach ja, zu dem Beitrag bzgl. 2 mal hintereinander abarbeiten geht ja bei mir nicht,... das Script startet ja immer automatisch, wenn ein neues Mail reinkommt,...

Lg max

 

Ich hatte übersehen, dass das ja ein VBA und kein VBS ist, aber das ändert an der Sache nichts... ausser dass mit VBScript das Schlafenlegen einfacher ginge.

Solche Makros kann man auf dem eigenen PC schlecht testen, und auf einem anderen PC gar nicht. Ich kann also nicht einen von mir getesteten Rat geben.

Ob eine For-1bis10-Schleife das könnte?
Ich denke, dass schon eine freundliche Meldung kommen wird, Item(8) sei leider nicht da...
Diese Meldung könnte man vielleicht abfangen mit SendKeys oder DisplayAlerts, aber dafür müsste man zuerst wissen, wie sie aussieht und welche Optionen mit welchem Default sie anbietet.

Eine zwischenzeitlich eintreffende Mail könnte auch diese Zählerei verwirren.
Geht es denn nicht mit mCount=....Items.Count?


Die während der Laufzeit des Makros eintreffenden Mails sind ein Schaissproblem, vor allem weil sachfremde Mails im Posteingang nicht zu verhindern sind. Es kann also keine Sollzahl der Mails festgelegt werden.

Kannst Du das Outlook-Makro nicht über einen VBScript starten lassen, der von den Geplanten Tasks zu einer Zeit gestartet, wo die Mails sicher angekommen sein müssen?
Wenn er in Outlook automatisch startet, rattert er ja bei jeder ankommenden Mail los... Tag und Nacht...

Die Anzahl der hier benötigten Nutz-Mails ist immer 3 - Richtig?
Dann würde ich in der Richtung forschen >

- Vor der For-Schleife zwei Zeilen einfügen
Eine Sprungmarke >> nochmals1:
Eine Variable >> mOK = 0
diese zählt die gelungenen Operationen

- In beiden grossen IF-Blöcken, nach dem Move-Befehl eine Zeile einfügen >> mOK = mOK + 1

- Zuletzt im Sub, vor dem End Sub, einfügen

Code:

          'wenn alles richtig gemacht > fertig    
    If mOK = 3 Then End Sub

tStart = Timer
tEnd = Timer + 20      'Wartezeit in Sekunden

    Do While Timer < tEnd
            'Korrektur, wenn Zeit über Mitternacht gehen sollte
        If Timer < tStart Then tEnd = tEnd - 86400
    Loop

            'beginnt nochmals mit der For-Schleife
    GoTo nochmals1

End Sub

Aber ein Problem >>> Der "Wartecode" rackert sich ab in seiner Schlaufe >> kann Outlook während dieser Zeit Mails empfangen? Keine Ahnung!

Andere Wartemöglichkeiten kenne ich in VBA nicht.

Gruss Urs

 

Ich habe doch noch eine Wartemöglichkeit gefunden, die bei mir funktioniert.
Sie dürfte das Empfangen neuer Mails während der Warterei weniger stören. Sie muss zwar auch abzählen, aber das muss Windows machen und nicht ein Outlook-Script, der muss nur warten...

Diese Zeile ausserhalb des Sub deklarieren, also oberhalb von "Public Sub Application_NewMail()" eingeben >>>

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Mein vorheriger Code-Ausschnitt müsste dann so aussehen >>>

Code:

          'wenn alles richtig gemacht > fertig    
    If mOK = 3 Then End Sub

    Sleep (10000)         ' Warten in Tausendstel-Sekunden

            'beginnt nochmals mit der For-Schleife
    GoTo nochmals1

End Sub

Gruss Urs

 

Hi,...

habs jetzt,... habs ein paar Tage zur Probe laufen lassen und es funktioniert einwandfrei,...
es ist vielleicht nicht die beste und schönste Lösung, aber es funktioniert,...

das mit deinem Sleep werd ich aber glaub ich auch noch reinbauen,... schaut ja viel schöner aus,...dazu gleich mal ein herzliches Dankeschön,...

Anbei noch mein Code, den ich im Moment verwende,... vielleicht kann er manch andere weiterhelfen,...

Lg max

Code:

Public Sub Application_NewMail()

'    Variablen-Deklaration
    Dim Ordnername As String
    Dim OrdnernameOEKO As String
    Dim objPosteingang As MAPIFolder
    Dim objNewMail As MailItem
    Dim mOk As Integer
    Dim Durchlauf As Integer
    Dim dl As Integer
        
'    Fehlermeldungen werden deaktiviert
'    Script fährt einfach mit nächstem Befehl fort
    On Error Resume Next
    
'    Ordnerdeklaration im Posteingang
    Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'    Unterordner AGCS_Synth
    Set myNewFolder = objPosteingang.Folders(6).Folders(1)
'    Unterordner ÖKO_Fahrplan
    Set myNewFolderOEKO = objPosteingang.Folders(5)
    
'    Ordner zum Speichern der Dateien
    Ordnername = "K:\tmp\synth_Gas\in"
    OrdnernameOEKO = "H:\ALLGMEIN\LS_DATA\Fahrplan\OEKO_FPL"
    
    mOk = 0
    Durchlauf = 0
    dl = 0
        
Nochmals:
    
    Durchlauf = Durchlauf + 1
    
'    Die Schleife behandelt jedes Mail, dass sich zum Startzeitpunkt
'    der Prozedur im Posteingang befand
    For Each objNewMail In objPosteingang.Items
        With objNewMail
        
'        AGCS_SynthLP Mail
'
'        Bedingungen:
'        Betreff und Absender gleich
'        Anlage vorhanden und Anlagenname beginnend mit "synth"
'        Mail noch nicht gelesen
        If .Subject = "DATA" And .SenderEmailAddress = "xxx@xxx.at" Then
            If .Attachments.Count > 0 Then
                If .UnRead = True Then
                    If .Attachments.Item(1).FileName Like "synth*" Then
'                        Speichern der Anlage
                        .Attachments.Item(1).SaveAsFile Ordnername & "\" & .Attachments.Item(1).FileName
'                        Als gelesen markieren
                        .UnRead = False
'                        Mail verschieben
                        .Move myNewFolder
'                        Zählen, wie viele AGCS-Mails schon behandelt wurden
                        mOk = mOk + 1
                    End If
'                    Bei dem Mail mit der Anlage *00001* wird eine Benachrichtigung
'                    über den Erhalt der AGCS-Mails ausgeschickt
                    If mOk < 4 Then
                        If .Attachments.Item(1).FileName Like "synthlp-008-00001*" Then
                            Set server_shell = CreateObject("wscript.shell")
                            server_shell.run "%comspec% /c net send pcxxx.at Neue AGCS_Synth_LP vorhanden", 0, True
'                            PC Reithmayr
                            server_shell.run "%comspec% /c net send pcxxx.at Neue AGCS_Synth_LP vorhanden", 0, True
                            'server_shell = Null
                        End If
                    End If
                End If
            End If
        End If
        
'        ÖKO - Fahrplan
'
'        Bedingungen:
'        Absender gleich
'        Anlage vorhanden und Anlagenname beinhaltet mit "14X"
'        Mail noch nicht gelesen
        If .SenderEmailAddress = "xyz@xyz.at" Then
            If .Attachments.Count > 0 Then
                If .UnRead = True Then
                    If .Attachments.Item(1).FileName Like "*14X*" Then
                        .Attachments.Item(1).SaveAsFile OrdnernameOEKO & "\" & .Attachments.Item(1).FileName
                        .UnRead = False
                        .Move myNewFolderOEKO
'                        Nachdem nur ein Mail mit einem Öko-Fahrplan zu dieser Prozedur-Zeit existiert
'                        wird das erfolgreiche Ende der Schleife mit nachfolgendem Wertsetzen realisiert
                        mOk = 3
                        
'                        Aufrufen des Sound über eine Kommandozeile
                        Set objMedia = CreateObject("wscript.shell")
                        datei = "D:\xyz.WAV"
                        objMedia.run "" & datei, 2
                       
                        
'                        Öffnen von Fahrplan.xls
                        Set objExcel = CreateObject("Excel.Application")
                        Set objWorkbook = objExcel.Workbooks.Open("H:\Fahrplan.xls")
                        
'                        Sichtbar setzen
                        objExcel.Visible = True
                        
'                        Makro "ÖKO_FPL" ausführen
                        objExcel.run ("ÖKO_FPL")
                        
'                        Script schlafen legen, um das Abspeichern nicht abzuwürgen (bin mir nicht sicher, obs funkt)
                        wscript.sleep 15000
                        
'                        Schließen
                        objExcel.Quit
                        
                        objExcel = Null
                        objWorkbook = Null
                        
                    End If
                End If
            End If
        End If
        
        End With
    Next objNewMail
    
'    Wenn alle 3 AGCS Mails bzw. 1 Öko-Fahrplan Mail erhalten und
'    abgehandelt worden ist, wird alles auf Null gesetzt und beendet
    
    If mOk = 3 Or mOk = 0 Then
    
    objPosteingang = Null
    myNewFolder = Null
    myNewFolderOEKO = Null
    
    server_shell = Null
    
    Ordnername = Null
    OrdnernameOEKO = Null
    mOk = Null
    Durchlauf = Null
        
    GoTo Ende
    
    End If
    
'    Wenn noch nicht alle 3 AGCS-Mails behandelt wurden
'    soll die Prozedur noch 3 mal ablaufen.
'    Sind jedoch schon mehr AGCS-Mails behandelt worden
'    wird die Prozedur sicherheitshalber noch 5 mal ablaufen.
    If mOk < 3 Then
        dl = 3
    Else
        dl = 5
    End If

'    Das Script läuft dl mal durch.
'    Jeder Durchlauf wird um 60 Sekunden ( 1 Min ) verzögert.
'    Gesamtdauer dl Minuten

    If Durchlauf < dl Then
        tStart = Timer
'        Wartezeit in Sekunden / Durchlauf
        tEnd = Timer + 60
    
        Do While Timer < tEnd
'            Korrektur, wenn Zeit über Mitternacht gehen sollte
'            If Timer < lSng_Start Then lSng_End = lSng_End - 86400
'            Freigabe für andere Prozesse für das OS während Wartezeit
            DoEvents
        Loop
'        nächster Durchlauf
        GoTo Nochmals
        
    End If
    
Ende:
        
End Sub

 

Danke für das Zeigen des, theoretisch nicht wirklich zu testenden, Resultats.
Aber Meckern muss sein >

>> die Zeile "wscript.sleep 15000" in ÖKO ist wirkungslos. Sie produziert den Laufzeitfehler "wscript ist kein gültiges Objekt".
Da Du mit "On error resume next" die Meldung unterdrückst, siehst Du nicht einmal diese...
Tipp > Zum Testen "On error resume next" deaktivieren.
Diese Lösung geht nur mit der Deklarationszeile aus Beitrag 8, und dann dem Befehl "Sleep (15000)"

>> die Zeile "If Timer < lSng_Start Then lSng_End = lSng_End - 86400"
in der Abteilung Schlafen, hat so keinen Sinn, Du hattest sie ja auch auskommentiert >
so ist sie wirksam > "If Timer < tStart Then tEnd = tEnd - 86400"

Wenn die DoLoop-Schlaufe 30 Sekunden vor Mitternacht starten sollte, ist tStart = 86370 und tEnd = 86430.
Die Schlaufe läuft sich dann tot, ein ganzer Tag hat ja nur 86400 Sekunden. Mit dem IfThen wird aber um Mitternacht tEnd = 30

Frage dazu: Musstest Du das DoEvents dort einfügen, damit Outlook weitere Mails empfangen kann?

>> Mit der Variablen mOk bin ich nicht so recht klar gekommen...Nimm doch zwei Variablen >
mOk für die Dreier-Gruppe
mOk1 für das Einzelkind
dann weisst Du genau was noch fehlt und kannst die nötigen Befehle geben.

Gruss Urs