Hallo zusammen,
nach mehreren Versuchen das Problem selber zu beheben, muss ich mich doch an Profis wenden.
Ein Kunde benutzt seit längerem ein Script zum archivieren von Mails. Er verschiebt die gewünschten Mails in einem Outlook Ordner (Ablage_Sammelordner). Diese Mails werden dann über das Makro in einem Ordner auf C: abgelegt. Das hat bis gestern Problemlos funktioniert.
Nun taucht seit gestern beim Ausführen des Makro diese Fehlermeldung auf: Laufzeitfehler -2147221233 (8004010f): Der versuchte Vorgang konnte nicht ausgeführt werden. Ein Objekt wurde nicht gefunden.
Beim Debuggen zeigt er ein Fehler in dieser Zeile an:
Set SO_Folder = Outlook.Application.Session.Folders.Item("E-Mail-Adresse").Folders.Item("Ablage_Sammelordner")
Habe den Script mal testweise auch auf meinem Laptop getestet, aber da kommt die gleiche Fehlermeldung raus. Habe auch versucht einen anderen Ordner zu archivieren (dachte evtl stimmt etwas mit dem Ordnerinhalt nicht), führte jedoch zu keinem Ergebnis.
Anbei noch das komplette Script:
Private Sub SaveOnCDrive_JJJJ()
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.Inspector
Dim objItem As Object
Dim Pfad, DatNam, Empf, Absend, Betr, EDat, ETime, EPfad As String
Dim SaveOK As Boolean
Dim EmpfDat As Date
Dim Kat As String
Set myItem = myOlApp.ActiveInspector
Pfad = "C:\E-Mail-Archiv\"
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
Empf = Left(objItem.To, 25)
Betr = Left(objItem.Subject, 30)
If InStr(objItem.SenderEmailAddress, "@") = 0 Then
Absend = objItem.SenderName
Else
Absend = objItem.SenderEmailAddress
End If
' entfernen von Sonderzeichen
Call SonderzeichenErsetzen(Empf)
Call SonderzeichenErsetzen(Betr)
Call SonderzeichenErsetzen(Absend)
' Kategorie "abgelegt" setzen
Kat = objItem.Categories
If InStr(1, Kat, "abgelegt") = 0 Then
objItem.Categories = Kat & "; abgelegt"
objItem.Save
End If
EmpfDat = objItem.ReceivedTime
EDat = Year(EmpfDat) & "-" & Right("0" & Month(EmpfDat), 2) & "-" & Right("0" & Day(EmpfDat), 2)
EPfad = Pfad & Year(EmpfDat) & "\"
ETime = Right("0" & Hour(EmpfDat), 2) & Right("0" & Minute(EmpfDat), 2)
DatNam = EDat & "_" & ETime & "__" & Absend & "__" & Betr & "__An_" & Empf
SaveOK = objItem.SaveAs(EPfad & DatNam & ".msg", olMSG)
Else
MsgBox "There is no current active inspector."
End If
End Sub
Sub Ordnerablage_JJJJ_starten()
Dim SO_Name As Variant
Dim SO_AnzahlMails, SO_Abgelegt As Integer
'Dim SO_olApp As Outlook.Application
'Dim SO_Folder As Outlook.Folder
'Dim SO_Mail, SO_Item As Variant
Set SO_olApp = Outlook.Application
Set SO_Folder = Outlook.Application.Session.Folders.Item("E-Mail-Adresse").Folders.Item("Ablage_Sammelordner")
Set SO_Mail = SO_Folder.Items
SO_AnzahlMails = SO_Mail.Count
SO_Abgelegt = 0
MsgBox (SO_AnzahlMails & " Mails sind im Ordner vorhanden.")
For Each SO_Item In SO_Mail
SO_Item.Display
Call SaveOnCDrive_JJJJ
SO_Item.Save
SO_Abgelegt = SO_Abgelegt + 1
SO_Item.Close olSave
Next
MsgBox ("Es wurden " & SO_Abgelegt & " Mails abgelegt")
End Sub
Sub SonderzeichenErsetzen(Text)
Text = Replace(Text, "\", "{")
Text = Replace(Text, "/", "{")
Text = Replace(Text, ":", ";")
Text = Replace(Text, "*", "+")
Text = Replace(Text, "?", "¿")
Text = Replace(Text, """", "'")
Text = Replace(Text, "<", "[")
Text = Replace(Text, ">", "]")
Text = Replace(Text, "|", "{")
End Sub
|