Makro Funktioniert nicht nach Office Update.

Moderator: ModerationP

Makro Funktioniert nicht nach Office Update.

Beitragvon Odatas » 03. Aug 2018, 12:46

Also ic hab von Office 2013 nach 2016 (Office 365) geupdate. Auf einmal funktioniert mein Outlook Makro nicht.

Der Fehler geschieht direkt am Anfang bei der 3. Set Anweisung

Code: Alles auswählen
    Set myDestFolder = Application.GetNamespace("MAPI").GetSharedDefaultFolder(myRecipient, olFolderInbox).Folders("AZN")


Das ganze Makro:

Code: Alles auswählen
Sub Anlage_verschieben()
'Dieses Sub durchläuft das PMO Postfach nach Mails die einen AZN als Anhang haben speichert diese ab und verschiebt die Mail
    Dim strPath As String 'Variable für den Pfad
    Dim attaCopy As Boolean
    Dim objBackUp As MAPIFolder 'Variable für Outlook Ordner 'Für Version 2
    Dim objMail As MailItem 'Variable für Mail
    Dim intAnlagen As Integer, i As Integer, j As Integer, AttachmendDownloaded As Integer 'Bisschen was zum Zählen
    Dim myNamespace As Outlook.NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim myDestFolder As Outlook.MAPIFolder
    AttachmendDownloaded = 0
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient("bp-pmobonprix")
    Set myDestFolder = Application.GetNamespace("MAPI").GetSharedDefaultFolder(myRecipient, olFolderInbox).Folders("AZN")
   
   
    If MsgBox("Dieses Makro durchläuft alle Mails im PMO Posteingang und sucht nach Anlagen. Möchtests du Fortfahren?", vbOKCancel) = 2 Then
            Exit Sub
        End If
       
         MsgBox "Das durchlaufen kann mehrere Minuten dauern. Es wird währenddessen so aussehen als ob nichts passiert. So lange keine Fehlermeldung oder der Abschlussdialog auftaucht arbeitet das Programm weiter. Einfach ein bischen warten.", vbOKOnly
'Bei Fehler:
    On Error GoTo ThisMacro_err
   
'Pfad zu Ziel Ordner wo die Anhänge gespeichert werden. Es werden Unterordner für die KW im Dateinamen erstellt.
    strPath = "J:\PMO\Zeitnachweise\Kalenderwoche\Outlook Export"
   
'Alle Mails im PMO Postfach
    Set objBackUp = Application.GetNamespace("MAPI").GetSharedDefaultFolder(myRecipient, olFolderInbox)
   
   
   
'Schleife von hinten (Älteste Mail zuerst)
    For j = objBackUp.Items.Count To 1 Step -1
       
'Mails auf vorh. Anlagen prüfen
        intAnlagen = objBackUp.Items(j).Attachments.Count
        If intAnlagen > 0 Then
        On Error Resume Next
            For i = 1 To intAnlagen
'Anlagen im vordefinierten Verzeichnis sichern. Nimmt nur Anhänge die "PMO-01_Programm_bonprix_AZN" enthalten.
                If InStr(1, objBackUp.Items(j).Attachments.Item(i).FileName, "PMO-01_Programm_bonprix_AZN", vbTextCompare) > 0 Then
                   
                   
'Prüfen ob KWXX Unterordner schon besteht und wenn nicht erstellen.
                    If Dir(strPath & "\" & Mid(objBackUp.Items(j).Attachments.Item(i).FileName, InStr(1, objBackUp.Items(j).Attachments.Item(i).FileName, "KW", vbTextCompare), 4), vbDirectory) = "" Then
                        MkDir (strPath & "\" & Mid(objBackUp.Items(j).Attachments.Item(i).FileName, InStr(1, objBackUp.Items(j).Attachments.Item(i).FileName, "KW", vbTextCompare), 4))
                    End If
                   
'Anlage in Unterordner speichern. Wenn es schon eine Anlage mit dem gleichen Namen gibt wird diese Überschrieben.
                    objBackUp.Items(j).Attachments.Item(i).SaveAsFile strPath & "\" & Mid(objBackUp.Items(j).Attachments.Item(i).FileName, InStr(1, objBackUp.Items(j).Attachments.Item(i).FileName, "KW", vbTextCompare), 4) & "\" & objBackUp.Items(j).Attachments.Item(i).FileName
'Variable Setzen um Verschiebung der Mail zu triggern
                    attaCopy = True
                    AttachmendDownloaded = AttachmendDownloaded + 1
                End If

                Next i
                  On Error GoTo ThisMacro_err
'Mail Verschieben
                If attaCopy Then
                    objBackUp.Items(j).Move myDestFolder
                    attaCopy = False
                End If
            End If
            Next j
           
           
'Wenn alles gut läuft nochmal nen Hinweis zurück geben.
            MsgBox "Es wurden " & AttachmendDownloaded & " Anhänge aus dem Postfach heruntergeladen und nach " & strPath & " verschoben. Die E-Mails, in denen Anhängen gefunden wurden, wurden in den Unterordner AZN verschoben.", vbOKOnly, "Erfolg"
           
'Exit Routine
ThisMacro_exit:
            Set objBackUp = Nothing
            Set myDestFolder = Nothing
            Set objBackUp = Nothing
            Set myRecipient = Nothing
            Set myNamespace = Nothing
            Exit Sub
           
'Bei Fehler werden verschiedene Daten ausgegeben.
ThisMacro_err:
            MsgBox "Da ist was schief gelaufen. Aber keine Panik. Bei jeder Mail die nicht mehr im Posteinang ist wurde der Anhang bereits gespeichert: " _
            & vbCrLf & " Anhänge: " & i & " Email: " & j _
            & vbCrLf & "Betreff: " & objBackUp.Items(j).Subject _
            & vbCrLf & "Die Folgenden Informationen könnten dir helfen" _
            & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
            & vbCrLf & "Error Number: " & Err.Number _
            & vbCrLf & "Error Description: " & Err.Description _
            , vbCritical, "Error!"
            Resume ThisMacro_exit
           
        End Sub


Er wirft dann folgende Fehlermeldung aus:

Laufzeitfehler '-2147221233 (8004010f)'

Der Versuchte Vorgang konnte nicht ausgeführt werden. Ein Objekt wurde nicht gefunden.
Odatas
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 13
Registriert: 23. Jan 2018, 14:52

Re: Makro Funktioniert nicht nach Office Update.

Beitragvon Odatas » 03. Aug 2018, 13:20

Also ich hab mal weiter geschaut.

Wenn ich

Code: Alles auswählen
Set myDestFolder = Application.GetNamespace("MAPI").GetSharedDefaultFolder(myRecipient, olFolderInbox)


mache, also das .Folders("AZN") hinten weg lasse dann funktioniert das ohne Problem. Und in der Variablen zeigt er mir bei "Folders" "Count=0" an. Aus irgend einem Grund kann er also nicht auf die Sub Folders zugreifen... Im Outlook Client kann ich da aber ganz normal rein und sehe die Subfolder. Ich bin etwas verwirrt.
Odatas
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 13
Registriert: 23. Jan 2018, 14:52

Re: Makro Funktioniert nicht nach Office Update.

Beitragvon Odatas » 03. Aug 2018, 13:46

Die Einstellung

"Fregeben Ordner herunterladen"

raus nehmen hat geholfen. Jetzt gehts wieder.
Odatas
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 13
Registriert: 23. Jan 2018, 14:52

Re: Makro Funktioniert nicht nach Office Update.

Beitragvon Gast » 09. Aug 2018, 10:07

Danke für die Info, wie du das gelöst hast!

Das kann auch anderen helfen.
Gast
 


Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste