Hallo zusammen, folgendes Problemchen stellt sich mir im Moment beim Speichern der Anhänge neuer mails in Outlook per Makro:
Jeden Tag um 6 Uhr erhalte ich von einem Nicht-Windowsrechner zwei Dateien mit .csv-Dateien im Anhang, die dann in Outlook per Regel in einen Ordner, sagen wir charts verschoben werden. Ein Makro in Diese Outlook Sitzung soll automatisch bei Eingang einer neuen Email in diesem Outlookordner die Anhänge dieser beiden Mails in einen Datei-Ordner charts auf der Festplatte speichern. Dies funktioniert, wenn ich das Makro manuell anschubse auch bestens, allerdings ohne Eingriff (Rechner läuft 24/7, kein Energiesparmodus) funktioniert es nur sporadisch, dass beide Anhänge automatisch gespeichert werden. Es wird oft nur der Anhang der "obersten", neuesten Mail (beide kommen durch den Abruf von Outlook ja um ca: 6:01 an) gespeichert, die andere Mail ist weiterhin ungelesen und der Anhang wird nicht gespeichert.
Da zu einer bestimmten Zeit später eine weitere automatische Verarbeitung dieser Daten durch eine Exceltabelle erfolgt, ist das immer ärgerlich. Es funktioniert alles, aber das automatische Speichern ALLER Anhänge ohne Beitun nicht.
Auch das Starten von Outlook mit dem explizitem Befehl
ECHO OFF
"C:\Program Files\Microsoft Office\OFFICE14\OUTLOOK.EXE" /autorun NewMail_modul
mittels Aufgabenplanung hilft nicht. Zuvor hatte ich den untenstehenden Makrotext in einem Modul mit anderem Namen als in DieseOutlookSitzung kopiert.
Ich vermute den Fehler irgendwo in der If-Schleife, habe mir den Code aber mit meinen rudimentären Kenntnissen selbst mühselig zusammengebastelt. Ich hoffe Ihr habt den entscheidenden Tipp.
Der Rechner hat mehrere Benutzer und der, unter dem dieses Makro läuft ist NICHT der Admin. Da aber sonst alle anderen Makros funktionieren dürfte dies doch nicht das Problem sein oder?
Freue mich von Euch zu hören!
Sub Application_NewMail()
'Sub Anlage(oMail As MailItem)
Dim fso As Object
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim strNewFolder As String
Dim intAnlagen As Integer
Dim i As Integer
Dim FolderPath As String
Dim DateFolderPath As String
'Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox). _
Folders.Item("charts")
FolderPath = "C:\ungesicherte_Daten\charts\"
DateFolderPath = FolderPath
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(FolderPath) Then
fso.CreateFolder FolderPath
End If
If Not fso.FolderExists(DateFolderPath) Then
fso.CreateFolder DateFolderPath
End If
'vorher mit s am Ende, items
For Each objNewMail In objPosteingang.Items
With objNewMail
If .UnRead = True Then
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
For i = 1 To intAnlagen
If Not fso.FileExists(DateFolderPath & "\" & .Attachments.Item(i). _
FileName) Then
.Attachments.Item(i).SaveAsFile DateFolderPath & "\" & .Attachments. _
Item(i).FileName
End If
Next i
End If
End If
End With
Next objNewMail
Set fso = Nothing
'Emails als ungelesen markieren
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set myFolder = objPosteingang ' Ordner zum Zählen der ungelesenen Mails angeben
NumItems = myFolder.Items.Count ' E-Mails zählen
For i = 1 To NumItems
myFolder.Items(i).UnRead = False ' Wert auf Gelesen setzen
Next
End Sub