Outlook Anhang speichern / entzippen / importieren

Bild

Betrifft: Outlook Anhang speichern / entzippen / importieren
von: Willi Wacker
Geschrieben am: 22.08.2015 08:14:54

Hallo,
ich habe in diesem Forum schon hervoragende Ansätze und Lösungen für meine Aufgaben gefunden und daher wende ich mich jetzt auch direkt an Euch. Ich bin auf der Suche nach einer Lösung für ein Problem, daß wohl eher einen erfahrenen VBA Programmierer benötigt.
Aufgabe ist folgende:
Excelmacro starten und dann:
1.) aus Outlook eine Mail herausfischen die NICHT im persönlichen Ordner sondern unter WWacker/Postfach/Firma/Neue Mail steht. Geht von Firma@web.de an test@wwacker.de
2.) fragen: ist heute von der Firma eine neue Mail eingegangen. (Anm. das passiert täglich, aber zu sehr unterschiedlichen Zeiten)
3.) wenn ja: suchen nach einem Teil im Betreff: blabla - dieser Text - 22.08.2014. wenn nein Infofenster zum Bestätigen und dann beenden
4.) Anhang (ist gezippt) nach c:\temp schreiben, auch dann, wenn der Dateiname schon vorhanden ist
5.) Anhang entzippen und Inhalt nach c:\temp schreiben. Vorhandene Datei ohne Nachfrage überschreiben
6.) Email löschen
7.) die Entzippte Datei in Excel einlesen --- und ab hier und die weitere Verarbeitung habe ich bereits.
Ich weiß, daß man normalerweise jetzt einen Code angibt, der zeigt, wie weit man ist, aber das ist jetzt die Schwierigkeit. Ich komme immer wieder auf den Code von Jens ("https://www.herber.de/forum/archiv/1272to1276/1272628_Outlook_EMail_Anhang_speichern.html#1272628" Thema:Outlook EMail Anhang speichern) aber damit ist mir schon nicht weitergeholfen, da ich ja nicht im "Persönlichen Ordner/Postfach" meine Mail finde.
Ggf. besteht ja die Möglichkeit - so meine Vorstellung - daß wir step by step vorgehen, denn auch wenn ich nur wenig Ahnung habe, will ich das natürlich im Wesentlichen selber erstellen, nur so versteht man es dann.
So wäre es vielleicht gut, wenn ich, aufbauend auf dem genannten Code, als erstes die Info bekäme, wie ich aus einer anderen als dem Standard Postfach eine Mail lesen bzw. Abfragen kann. Ich habe auch dazu schon etliche Lösungen gefunden, da die aber nicht für Excel 2007 geschrieben waren, wurde die Ausführung dann immer mit irgendwelchen Fehlern beendet.
Damit käme ich weiter und beim nächsten Mal kann ich dann auch schon meinen Code hier angeben.
Allen schon mal ein ganz herzliches "Danke schön" für Eure Hilfe.
Willi
Hier nun doch der Code und die Stelle an der ich verzweifle:
Sub OutlookPosteingang()
Dim objOL As Object, objFolder As Object
Dim strPath As String
Dim lngIndex As Long, lngCur As Long, lngCount As Long, lngRow As Long
Dim lngCalc As Long

On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strPath = "C:\HaWe-Ident\" 'Speicherpfad - Anpassen!

Set objOL = CreateObject("Outlook.Application")
Set objFolder = objOL.GetNamespace("MAPI").GetDefaultFolder(6) an dieser Stelle verzweifle ich, den ich will ja nach WWacker/Postfach/Firma/Neue Mail

Bild

Betrifft: AW: Outlook Anhang speichern / entzippen / importieren
von: Sepp
Geschrieben am: 22.08.2015 08:45:19
Hallo Willi,
auslesen und Anhang speichern.

Sub OutlookGetMail()
Dim olApp As Object, objFolder As Object, objItem As Object


Set olApp = CreateObject("outlook.application")
Set objFolder = olApp.GetNameSpace("MAPI").Folders("WWacker").Folders("Postfach").Folders("Firma").Folders("Neue Mail")

For Each objItem In objFolder.Items
  If objItem.Subject Like "*" & "dieser Text" & "*" Then
    If objItem.Attachments.Count > 0 Then
      With objItem.Attachments.Item(1)
        If .Filename Like "*.zip" Then
          .SaveAsFile "C:\Temp\" & .Filename
        End If
      End With
    End If
  End If
Next

Set objFolder = Nothing
Set olApp = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: Outlook Anhang speichern / entzippen / importieren
von: Case
Geschrieben am: 22.08.2015 09:30:20
Hallo, :-)
zum entzippen gib es hier schon alles "Pfannenfertig":
ZIP / UNZIP...
Servus
Case


Bild

Betrifft: AW: Outlook Anhang speichern / entzippen / importieren
von: Willi Wacker
Geschrieben am: 24.08.2015 05:30:45
Hallo Sepp,
ich knie nieder. Genau das war's. Danke!
Ich habe jetzt auch das Entzippen mit eingebaut, habe aber doch noch eine Frage, obwohl ich
Application.DisplayAlerts = False
eingebaut habe, werde ich immer noch gefragt, ob ich die Datei überschreiben möchte. Kann mir bitte noch jemand verraten, wo mein Fehler liegt?


Sub OutlookGetMail()
Dim olApp As Object, objFolder As Object, objItem As Object
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
Set olApp = CreateObject("outlook.application")
Set objFolder = olApp.GetNameSpace("MAPI").Folders("WWacker").Folders("Posteingang").Folders(" _
Firma").Folders("Neue Mail")
For Each objItem In objFolder.items
  If objItem.Subject Like "*" & "abzufragender Text" & "*" Then
    If objItem.Attachments.Count > 0 Then
      With objItem.Attachments.item(1)
        If .fileName Like "*.zip" Then
          .SaveAsFile "C:\Temp\" & .fileName
        End If
      End With
    End If
  End If
Next
    Application.DisplayAlerts = False
    Fname = "C:\Temp\Datei.zip"
    FileNameFolder = "C:\Temp\"
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
    Application.DisplayAlerts = True
Set objFolder = Nothing
Set olApp = Nothing
End Sub
Schon mal ganz herzlichen Dank im Voraus.
Willi

Bild

Betrifft: AW: Outlook Anhang speichern / entzippen / importieren
von: it@hasz.de
Geschrieben am: 24.08.2015 10:11:07
Hallo,
hier ein Nachtrag zu meiner letzten Anmerkung: ich habe die Lösung selbst gefunden.
Der Befehl


Application.DisplayAlerts = False

darf nicht im Modul (OutlookGetMail <-> s. unten) stehen, sondern muß im Hauptmodul um den Aufruf herum stehen. Also
Application.DisplayAlerts = False
Application.Run "Firma1.xlsm!OutlookGetMail.OutlookGetMail"
Application.DisplayAlerts = True
Trotzdem noch eine Frage: warum bekomme ich die Meldung:
Fehler beim Kompilieren
Variable nicht definiert

und das in der Zeile:
    Set oApp = CreateObject("Shell.Application")
wenn ich den Code in das Hauptmodul einfüge?

Option Explicit
Private Declare Function GetCommandLine Lib "kernel32.dll" Alias "GetCommandLineA" () As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
    ByVal lpString As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef pDst As Any, _
    ByRef pSrc As Any, _
    ByVal ByteLen As Long)
   
Public Function Get_CommandLine() As String
    Dim lngReturn As Long, lngLength As Long
    lngReturn = GetCommandLine
    lngLength = lstrlen(lngReturn)
    If lngLength Then
        Get_CommandLine = Space$(lngLength)
        Call CopyMemory(ByVal Get_CommandLine, ByVal lngReturn, lngLength)
    End If
End Function
Public Sub Makro1()
'
' Auswertung Makro
'
    Dim x1 As Long, y1 As Long, lngZielZeile As Long, lngLetzteZeile As Long, lngZaehler As  _
Long
    Dim n As Integer, x As Integer, Zeile As Integer, z1 As Integer, Z2 As Integer, Z3 As  _
Integer, i As Integer
    Dim erstellterStr As String, Wert As String
    Dim Inhalt  As Variant, Länge As Integer, Grenze As Integer, x2 As Integer, l As Integer
    Dim Zelle As Long
    Dim olApp As Object, objFolder As Object, objItem As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim wksA As Worksheet, wksE As Worksheet, wksZ As Worksheet
    
    Set wksA = Worksheets("Firma1")
    Set wksE = Worksheets("Endergebnis")
    Set wksZ = Worksheets("Firma2")
    
    lngZielZeile = wksE.Cells(Rows.Count, 1).End(xlUp).Row + 1
    lngLetzteZeile = wksA.Cells(Rows.Count, 4).End(xlUp).Row
    
' -------------------------- Outlook Datei sichern / entzippen ---
    
'    Application.Run "Firma1.xlsm!OutlookGetMail.OutlookGetMail"
    
    Application.DisplayAlerts = False
    Set olApp = CreateObject("outlook.application")
    Set objFolder = olApp.GetNameSpace("MAPI").Folders("WWacker").Folders("Posteingang"). _
Folders("Firma").Folders("Neue Mail")
    For Each objItem In objFolder.items
      If objItem.Subject Like "*" & "abzufragender Text" & "*" Then
        If objItem.Attachments.Count > 0 Then
          With objItem.Attachments.item(1)
            If .fileName Like "*.zip" Then
              .SaveAsFile "C:\Temp\" & .fileName
            End If
          End With
        End If
      End If
    Next
    Application.DisplayAlerts = False
    
    Fname = "C:\Temp\Datei.zip"
    FileNameFolder = "C:\Temp\"
    Set oApp = CreateObject("Shell.Application")' ist dann falsch?!?
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
    Application.DisplayAlerts = True
Set objFolder = Nothing
Set olApp = Nothing
'.......... etc.
Schon mal Danke im Voraus.
Willi
Hier nun der funktionierende Code für ein (Sub)modul:
1.) in Outlook bekannten Ordner nach Mail durchsuchen
2.) Mail nach Anhang abfragen
3.) Zip Anhang auf Festplatte schreiben
4.) Anhang entzippen (in den selben Ordner wie die zip Datei)

Sub OutlookGetMail()
    Dim olApp As Object, objFolder As Object, objItem As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Application.DisplayAlerts = False
    Set olApp = CreateObject("outlook.application")
    Set objFolder = olApp.GetNameSpace("MAPI").Folders("WWacker").Folders("Posteingang"). _
Folders("Firma").Folders("Neue Mail")
    For Each objItem In objFolder.items
      If objItem.Subject Like "*" & "abzufragender Text" & "*" Then
        If objItem.Attachments.Count > 0 Then
          With objItem.Attachments.item(1)
            If .fileName Like "*.zip" Then
              .SaveAsFile "C:\Temp\" & .fileName
            End If
          End With
        End If
      End If
    Next
    Fname = "C:\Temp\Datei.zip"
    FileNameFolder = "C:\Temp\"
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
Set objFolder = Nothing
Set olApp = Nothing
End Sub


Bild

Betrifft: AW: Durchblick durch Draufblick?
von: Gerd L
Geschrieben am: 24.08.2015 10:21:29
Hallo Willi!
Set oApp /Dim olApp
Gruß Gerd

Bild

Betrifft: AW: Durchblick durch Draufblick?
von: Willi Wacker
Geschrieben am: 25.08.2015 13:38:58
Hallo Gert,
im Prinzip vollkommen richtig, ABER! in dem Modul "Sub OutlookGetMail()" (s.u.) wird dieser Fehler kurioser Weise nicht angemeckert. Auch da ist keim Dim gesetzt. Egal. Ich habe das Problem jetzt gefixt.
Lösung:
es muß abgefragt werden, ob die Datei bereits besteht. Wenn ja umbenennen oder löschen. Mit "Application.DisplayAlerts = False" ist es offensichtlich nicht getan.
Jetzt ist mir aber noch eine Idee gekommen, und ich weiß jetzt nicht recht, ob ich dafür nicht eher eine neue Anfrage aufmachen sollte?!
Statt in Outlook nach der Mail zu suchen, wäre es für mich noch besser auf dem Server des Providers danach zu suchen.
Also:
hat WWacker@web.de (also mit Mail-Adresse und Paßwort bei web.de einloggen) von Firma@gmx.de heute eine Mail (mit besagtem Inhalt) bekommen?
Hat jemand dafür eine Idee/Lösung?
Willi

Bild

Betrifft: AW: Durchblick durch Draufblick?
von: Matthias
Geschrieben am: 25.08.2015 14:58:11
Hallo Willi,
wenn er meckert weil eine Variable nicht definiert ist liegt das am "Option Explicit" was ganz oben im Modul steht. Da es bei dem einen Makro keine Warnung gibt, hat das wohl sein eigenes Modul/Mappe, ohne diese Zeile. Liege ich richtig?
lg Matthias

Bild

Betrifft: AW: Durchblick durch Draufblick?
von: Willi Wacker
Geschrieben am: 26.08.2015 08:17:51
Hallo Matthias,
Danke, das war's.
Danken auch allen anderen für den Input.
Willi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Outlook Anhang speichern / entzippen / importieren"