Anzeige
Archiv - Navigation
1524to1528
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Outlook - Anhänge aus Email in bestimmten Ordner

Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 11:20:05
Julian
Liebe VBA-Freunde,
ich habe folgendes Problem:
Ich erhalte täglich eine Mail mit einem Report zum letzten Arbeitstag. Die Anhänge aus dieser Mail möchte ich in einem Order abspeichern, welcher nach dem Datum des letzten Arbeitstages benannt wurde.
Leider funktioniert mein Code bisher nicht (kann nur an Variable für letzten Arbeitstag liegen - denn mit heutigem Datum funktioniert es).
Hier der Code:

Public Sub Anhaenge_speichern(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Dim intMonth As Integer
For intMonth = 1 To 12
Debug.Print LastDay(2011, intMonth, 6) ' 6=Freitag
Next
Function LastDay(ByVal intYear As Integer, ByVal intMonth As Integer, ByVal intWeekday As  _
Integer) As Date
Dim d As Date
'intWeekday >> 1=Sonntag,...,7= Samstag
d = DateSerial(intYear, intMonth + 1, 0)
LastDay = IIf(Weekday(d, intWeekday) = 1, d, d - Weekday(d, intWeekday) + 1)
End Function
Set mAtts = myItem.Attachments
While mAtts.Count > 0
Set mAtt = mAtts(1)
mAtt.SaveAsFile "O:\Dat\5920\03AlleUser\" & Format(LastDay, "yyyymmdd") & "\" & mAtt. _
DisplayName
mAtts.Remove 1
Wend
End Function
Vielen dank für eure Hilfe und einen schönen Arbeitstag!
Julian

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 12:27:25
baschti007
was FÜR EIN FEHLER KOMMT DENN ?
Gruß Basti
Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 13:25:39
Julian
Es kommt keinerlei Fehlermeldung, nur wenn ich die Regel aktiviere, speichert er keine Anhänge im Ordner ab.
Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 14:27:12
baschti007
Hey Julian ich hatte letzte Woche hier auch schon mal so was
Die mails werden in diesem Bsp. noch in seperáte Ordner gepackt.
Hier der thread
https://www.herber.de/cgi-bin/callthread.pl?index=1523625#1523625

Sub Anlagen_Speichern(olMail As MailItem)
'Objekte/Variablen deklarieren
Dim Ziel As String
Dim Anlagen As Attachments
Dim i As Integer
'Speicherordner angeben (bitte mit Backslash abschließen!)
Ziel = "C:\Bastian\Add\"
'Abbruch, wenn Ordner nicht vorhanden
If Dir(Ziel, vbDirectory) = "" Then Exit Sub
'Mailanhänge ermitteln
Set Anlagen = olMail.Attachments
If olMail.Sender Is Nothing Then
Ziel = Ziel & "KEINE_MAIL" & "\"
Else
Ziel = Ziel & SonderzeichenWeg(Umlaut(olMail.Sender)) & "\"
End If
If Dir(Ziel, vbDirectory)  "" Then
Else
MkDir (Ziel)
End If
'alle Anhänge der Mail durchlaufen und speichern
For i = 1 To Anlagen.Count
'Dateiname zusammensetzen, Datum ist Empfangsdatum der Mail
If Anlagen.Item(i).Type  6 Then
Datei = Ziel & Format(olMail.ReceivedTime, "dd.mm.yyyy") & "_" & Anlagen.Item(i).Filename
'Anlage speichern
Anlagen.Item(i).SaveAsFile Datei
End If
Next i
End Sub
Function SonderzeichenWeg(var As String) As String
Dim i As Integer
Dim varohne As String
Const c_Sonder As String = " -.,_:;#+ß'*?=)(/&%$§!~\}][{"
For i = 1 To Len(c_Sonder)
var = Replace(var, Mid(c_Sonder, i, 1), "_")
Next i
SonderzeichenWeg = var
End Function
Public Function Umlaut(S)
Dim i As Integer, Ch As String * 1, Ch1 As String * 1, _
IsUpCase As Boolean, Res As String
If IsNull(S) Then Umlaut = Null: Exit Function
Res = ""
For i = 1 To Len(S)
Ch = Mid(S, i, 1)
Ch1 = IIf(i 
Gruß Basti
Anzeige
Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 16:11:42
Julian
Vielen Dank Basti.
Allerdings liegt mein Problem nicht in der Speicherung der Anhänge - sondern speziell in der Speicherung im Ordner benannt zum letzten Arbeitstag!
AW: Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 16:40:03
Bastian
Kann das sein das du die Next schleife falsch gesetzt hast ?
Gtruß BAsti

Public Sub Anhaenge_speichern(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Dim intMonth As Integer
For intMonth = 1 To 12
Debug.Print LastDay(2011, intMonth, 6) ' 6=Freitag
Set mAtts = myItem.Attachments
While mAtts.Count > 0
Set mAtt = mAtts(1)
mAtt.SaveAsFile "O:\Dat\5920\03AlleUser\" & Format(LastDay, "yyyymmdd") & "\" &  _
mAtt.DisplayName
mAtts.Remove 1
Wend
Next
End Function
Function LastDay(ByVal intYear As Integer, ByVal intMonth As Integer, ByVal intWeekday As  _
Integer) As Date
Dim d As Date
'intWeekday >> 1=Sonntag,...,7= Samstag
d = DateSerial(intYear, intMonth + 1, 0)
LastDay = IIf(Weekday(d, intWeekday) = 1, d, d - Weekday(d, intWeekday) + 1)
End Function

Anzeige
AW: Outlook - Anhänge aus Email in bestimmten Ordner
15.11.2016 16:43:40
Bastian
Ups End Sub nicht Function =D
Gruß Basti

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige