Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Outlook Anhang speichern / entzippen / importieren

Outlook Anhang speichern / entzippen / importieren
22.08.2015 08:14:54
Willi
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Outlook Anhang speichern / entzippen / importieren
22.08.2015 08:45:19
Sepp
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

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

AW: Outlook Anhang speichern / entzippen / importieren
24.08.2015 05:30:45
Willi
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

Anzeige
AW: Outlook Anhang speichern / entzippen / importieren
24.08.2015 10:11:07
it@hasz.de
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

Anzeige
AW: Durchblick durch Draufblick?
24.08.2015 10:21:29
Gerd
Hallo Willi!
Set oApp /Dim olApp
Gruß Gerd

AW: Durchblick durch Draufblick?
25.08.2015 13:38:58
Willi
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

Anzeige
AW: Durchblick durch Draufblick?
25.08.2015 14:58:11
Matthias
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

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

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige