Home-›Foren-›Outlook-›Outlook VBA-›VBA – Anhänge aus mails exportieren
- Dieses Thema hat 0 Antworten sowie 1 Stimme und wurde zuletzt vor 15:39 um 16. November 2007 von Unbekannt aktualisiert.
- AutorBeitrag
- 16. November 2007 um 15:39 #43782UnbekanntTeilnehmer
Habe das VBS Script, das auf dieser HP zur Verfügung gestellt wird getestet und finde es wirklich sehr praktisch. habe aber das Problem, dass wenn ich das Makro ausführe und auf abbrechen klicke, das Script trotzdem ausgeführt wird und mir der Anhang aus dem Mail ausgelöscht wird ohne es irgendwo zu speichern. Da ich kein Programmierer bin, wäre ioch froh wenn mir jemand sagen würde, was ich machen muss, damit das Script unterbrochen wird wenn ich auf abbrechen klicke.
Vielen Dank
SimonSub AnhaengeSpeichern()
‘Festlegen der Parameter
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myteils, myteil, myAnhänge, myAnhang As Object
‘Hier wird nach dem Ort gefragt wo gespeichert werden soll, _
‘wenn Sie den Pfad ändern. Muss dieser vorher schon erstellt sein
myOrt = InputBox(“Speicherort”, “Anhänge Speichern unter: “, “D:\Outlook\Attachment\”)
On Error Resume Next
‘arbeitet die einzelnen Nachrichten ab
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
‘für alle Teile…
For Each myteil In myOlSel
‘Anhänge festlegen
Set myAnhänge = myteil.Attachments
‘wenn welche dar sind, dann
If myAnhänge.Count > 0 Then
‘fügt einen Hinweis in die Email ein
myteil.Body = myteil.Body & vbCrLf & _
“Entfernte Anhänge:” & vbCrLf‘und für alle Anhänge…
For i = 1 To myAnhänge.Count
‘nun werden Sie am Speicherort abgelegt
myAnhänge(i).SaveAsFile myOrt & _
myAnhänge(i).DisplayName‘hier wird Name und der Ort in der Nachricht eingetragen
myteil.Body = myteil.Body & _
“Datei: ” & myOrt & _
myAnhänge(i).DisplayName & vbCrLfNext i
‘für alle Anhänge…
While myAnhänge.Count > 0
‘entferne es (wird für Outlook 2002/2003 benötigt)
‘myAnhänge.Remove 1
‘entferne es (wird für Outlook 2000 benötigt)
myAnhänge(1).Delete
Wend
‘abspeichern ohne Anhang
myteil.Save
End If
Next
‘free variables
Set myteils = Nothing
Set myteil = Nothing
Set myAnhänge = Nothing
Set myAnhang = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
Resume
End Sub
- AutorBeitrag