MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Outlook (Express), sonst. Mailprogramme
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 05.05.2018, 22:05   #1
Walperlohman@web.de
Neuer Benutzer
Neuer Benutzer
Standard VBA - Anhang einer E-Mail speichern

Hallo zusammen,

ich erhalte von einen Absender regelmässig eine E-Mail ("Email1"). In dieser E-Mail ("Email1") ist eine weitere E-Mail ("Email2") als Anhang enthalten.
Und in dieser weiteren E-Mail ("Email2") ist eine Exceldatei angehangen.

Nun suche ich ein Makro oder Ansätze, womit ich diese Exceldatei nach erhalten der regelmässigen E-Mail ("Email1") in einem bestimmten Ordner speichern kann.

Ich hoffe, ich habe mich verständlich ausgedrückt und ihr könnt mir bei meinem Problem helfen.
Danke


Gruß
Steven
Walperlohman@web.de ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.05.2018, 11:59   #2
Hasso
MOF Meister
MOF Meister
Standard

Hallo Steven,

ich hatte da mal etwas aus verschiedenen Fundstellen im Netz zusammengestrickt. Pack den Code bei Outlook in ThisOutlookSession.

Markiere vor dem Start des Makros die Mail(s) dereren Anhänge du speichern möchtest.
Code:

  'Dieses Makro speichert alle Anlagen der ausgewählten Elemente auf der Festplatte.
  'Abschließend wird noch der Dateiexplorer mit dem neuen Verzeichnis geöffnet.
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Att As Outlook.Attachment
  Dim SubAtt As Outlook.Attachment
  Dim Sel As Outlook.Selection
  Dim strPath As String
  Dim strFolder As String
  Dim intZaehler As Integer
  Dim objfolder As Object
Set objfolder = CreateObject("Shell.Application").BrowseForFolder(0, "Datei oder Verzeichnis wõhlen", 16, 17)
If Not TypeName(objfolder) = "Nothing" Then
  strPath = objfolder.Self.Path
Else
  MsgBox "kein Verzeichnis ausgewählt!"
  Exit Sub
End If
  'Wenn es das Verzeichnis schon gibt, soll kein Fehler erzeugt werden:
  On Error Resume Next
  MkDir strPath
  On Error GoTo 0

  Set coll = New VBA.Collection

  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    coll.Add Application.ActiveInspector.CurrentItem
  Else
    Set Sel = Application.ActiveExplorer.Selection
    For intZaehler = 1 To Sel.Count
      coll.Add Sel(intZaehler)
    Next
  End If

  For Each obj In coll
    For Each Att In obj.Attachments
      Att.SaveAsFile strPath & "" & Att.FileName
      'Wenn der Anhang eine msg-Datei ist, diese öffnen und deren Anhänge speichern:
      If Att.Type = olEmbeddeditem Then
        MSGOpen (strPath & "" & Att.FileName)
        'msg-Datei aus dem Ausgabeordner löschen:
        Kill strPath & Att.FileName
      End If
    Next
  Next
  'Hiermit wird das Fenster des Ausgabeordners geschlossen, falls es geöffnet ist:
  ExplorerfensterSchliessen (strPath)
  'Hiermit wird das Fenster des Ausgabeordners geöffnet:
  Shell "Explorer.exe /n, /e, " & strPath, vbNormalFocus
End Sub
Function MSGOpen(strPathName)
    Dim objMailItem As Outlook.MailItem
    Dim objMailOLApp As Outlook.Application
    Dim SubAtt As Outlook.Attachment

    Set objMailOLApp = New Outlook.Application
    Set objMailItem = objMailOLApp.CreateItemFromTemplate(strPathName)
    For Each SubAtt In objMailItem.Attachments
      'Anhänge speichern:
      SubAtt.SaveAsFile strPathName & SubAtt.FileName
    Next SubAtt
End Function
Sub ExplorerfensterSchliessen(strFolder As String)
Dim objWindow As Object

Dim objShell As Object
On Error GoTo Fehler
Set objShell = CreateObject("Shell.Application")
For Each objWindow In objShell.Windows
  If objWindow.LocationName Like strFolder Then objWindow.Quit
Next objWindow
Fehler:
    Set objShell = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub

__________________

Gruß Hasso

Programmers don't die, they just GOSUB without RETURN

System Windows 7 Enterprise 64, Office 2013
Wenn dir mein Beitrag gefallen hat, kannst du ihn bewerten (mit dem Symbol links unten)
Hasso ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:17 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.