VBA – Anhänge aus mails exportieren

Home-›Foren-›Outlook-›Outlook VBA-›VBA – Anhänge aus mails exportieren

Ansicht von 1 Beitrag (von insgesamt 1)
  • Autor
    Beitrag
  • #43782
    Unbekannt
    Teilnehmer

      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
      Simon

      Sub 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 & vbCrLf

      Next 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

    Ansicht von 1 Beitrag (von insgesamt 1)

    Du musst angemeldet sein, um auf dieses Thema antworten zu können.

    -