Outlook: Anhänge mehrerer Email speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub SavePGPOnHarddrive() Dim myAttachments As Outlook.Attachments Dim olMailItem As Outlook.MailItem Dim lngAttachCount As Long Dim strAttach As String Dim strPath As String ' Pfad angeben strPath = Environ("USERPROFILE") & "\Desktop\PGPFiles\" ' Aktive Mail setzen Select Case True Case TypeOf Application.ActiveWindow Is Outlook.Inspector Set olMailItem = Application.ActiveInspector.CurrentItem Case Else With Application.ActiveExplorer.Selection If .Count Then Set olMailItem = .Item(1) End With If olMailItem Is Nothing Then Exit Sub End Select ' Anhangobjekt erstellen Set myAttachments = olMailItem.Attachments ' Anhänge prüfen und speichern. Nur Dateien vom Typ PGP wird gespeichert If myAttachments.Count > 0 Then For lngAttachCount = myAttachments.Count To 1 Step -1 'If Right(myAttachments(lngAttachCount).DisplayName, 3) = "pgp" Then myAttachments(lngAttachCount).SaveAsFile strPath & _ myAttachments(lngAttachCount).FileName 'End If Next lngAttachCount End If End Sub

Hallöchen,

dann bauen wir mal bisschen was und eine Schleife ein :-) Ich nehme hier die Mails in ein Array und arbeite dann , sofern enthalten, die Anhänge ab

Sub SavePGPOnHarddrive()



  Dim myAttachments     As Outlook.Attachments

  Dim olMailItem        As Outlook.MailItem

  

  Dim lngAttachCount    As Long

  

  Dim strAttach         As String

  Dim strPath           As String

  

  Dim iCnt&, arrItems() As Object

  

  ' Pfad angeben

  strPath = Environ("USERPROFILE") & "\Desktop\PGPFiles\"

  

  ' Aktive Mail setzen

  Select Case True

    Case TypeOf Application.ActiveWindow Is Outlook.Inspector

      Set olMailItem = Application.ActiveInspector.CurrentItem

    Case Else

      With Application.ActiveExplorer.Selection

        If .Count Then

           For iCnt = 1 To .Count

             ReDim Preserve arrItems(iCnt)

             Set olMailItem = .Item(iCnt)

             Set arrItems(iCnt) = olMailItem

           Next

        End If

      End With

      If olMailItem Is Nothing Then Exit Sub

  End Select

      

  ' Anhangobjekt erstellen

   For iCnt = 1 To UBound(arrItems)

    'Set myAttachments = olMailItem.Attachments

    Set myAttachments = arrItems(iCnt).Attachments

    ' Anhänge prüfen und speichern. Nur Dateien vom Typ PGP wird gespeichert

    If myAttachments.Count > 0 Then

       For lngAttachCount = myAttachments.Count To 1 Step -1

           'If Right(myAttachments(lngAttachCount).DisplayName, 3) = "pgp" Then

              myAttachments(lngAttachCount).SaveAsFile strPath & _

              myAttachments(lngAttachCount).FileName

           'End If

       Next lngAttachCount

   End If

  Next

End Sub

Beliebteste Forumthreads (12 Monate)

Outlook: Anhänge mehrerer Email speichern

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Outlook: Anhänge mehrerer Email speichern

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread