Ablage von Anhängen

Moderator: ModerationP

Ablage von Anhängen

Beitragvon Tarje_089 » 15. Mai 2017, 14:32

Hallo Zusammen,

ich hoffe mir kann einer von Euch weiterhelfen.
Ich habe ein Makro gefunden mit dessen Hilfe ich die Anhänge ausgewählter Mails auf dem Laufwerk ablegen kann.
Mein Problem ist nun, dass auch die Icons aus den E-Mails wie beispielsweise LinkedIn, Google+ und Twitter mit abgelegt werden, welche in den Signaturen aufgeführt sind.
Besteht eine Möglichkeit diese vom Makro auszuschließen?

Code: Alles auswählen
Sub Anlage_verschieben()
Dim strPath As String
Dim objMail As MailItem
Dim intAnlagen As Integer, i As Integer
On Error Resume Next
'Pfad zu meinem Ordner
strPath = "Speicherpfad"
'Schleife
For Each objMail In Outlook.ActiveExplorer.Selection
With objMail
'Mails auf vorh. Anlagen prüfen
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
For i = 1 To intAnlagen
'Anlagen im vordefinierten Verzeichnis sichern
.Attachments.Item(i).SaveAsFile strPath & "\" & Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
Next i
End If
End With
Next objMail
End Sub


Vielen Dank im Voraus und Gruß
Tarje
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon Michael Bauer » 16. Mai 2017, 05:35

Hallo,

so kannst Du die Dateiendungen für die Dateitypen angeben, die gespeichert werden sollen:
Code: Alles auswählen
select case right$(.Attachments.Item(i).FileName,4)
case ".xls", ".doc"
  'speichern
end select
Michael Bauer
Add-Ins für Microsoft Outlook
Benutzeravatar
Michael Bauer
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6378
Registriert: 03. Feb 2005, 15:07
Wohnort: Vollersode

Re: Ablage von Anhängen

Beitragvon Tarje_089 » 16. Mai 2017, 06:51

Hallo Michael,

vielen Dank schon mal für Deine Rückmeldung. Ich habe den Code jetzt folgendermaßen zusammengesetzt:

Code: Alles auswählen
Sub Anlage_verschieben_Test()
Dim strPath As String
Dim objMail As MailItem
Dim intAnlagen As Integer, i As Integer
On Error Resume Next
'Pfad zu meinem Ordner
strPath = "Speicherpfad"
'Schleife
For Each objMail In Outlook.ActiveExplorer.Selection
With objMail
'Anlagen auswählen
Select Case Right$(.Attachments.Item(i).FileName, 4)
Case ".xls", ".doc"
  'speichern
End Select
'Mails auf vorh. Anlagen prüfen
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
For i = 1 To intAnlagen
'Anlagen im vordefinierten Verzeichnis sichern
.Attachments.Item(i).SaveAsFile strPath & "\" & Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
Next i
End If
End With
Next objMail
End Sub


Leider werden die Bilder, weiterhin gespeichert.
Das andere Problem ist, sofern der Code funktionieren würde, würden ja Jpeg-Dateien aus den Anhängen auch nicht mehr gespeichert werden, oder?
Ich möchte lediglich verhindern, dass Dateien welche sich nicht im Anhang befinden gespeichert werden.

Gruß
Tarje
Zuletzt geändert von Tarje_089 am 16. Mai 2017, 07:02, insgesamt 1-mal geändert.
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon mumpel » 16. Mai 2017, 07:02

Hallo!

Deine Select-Case-Anweisung ist leer, greift somit nicht. Die Speichern-Anweisung muss innerhalb der Select-Case-Abfrage stehen.

Gruß, René
Benutzeravatar
mumpel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8155
Registriert: 09. Jan 2005, 15:20
Wohnort: Lindau (B)

Re: Ablage von Anhängen

Beitragvon mumpel » 16. Mai 2017, 07:06

Code: Alles auswählen

For i = 1 To intAnlagen
 Select Case Right$(.Attachments.Item(i).FileName, 4)
    Case ".xls", ".doc", ".jpg", ".jpeg", ".pdf"
       .Attachments.Item(i).SaveAsFile strPath & "\" & Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
 End Select
Next i

Benutzeravatar
mumpel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8155
Registriert: 09. Jan 2005, 15:20
Wohnort: Lindau (B)

Re: Ablage von Anhängen

Beitragvon Tarje_089 » 16. Mai 2017, 07:19

Hallo Rene,

vielen Dank. Ich habe auch dieses Makro getestet, nur werden die Icons aus der Signatur leider weiterhin gespeichert, da diese auch .jpeg-Dateien sind.
Wie kann ich das Makro dazu bringen, dass nur wirklich angehängte Anlagen gespeichert werden?

Gruß
Tarje
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon mumpel » 16. Mai 2017, 07:56

Leider nichts zu machen. Bitte doch Deine Kontakte sie mögen Dir Emails bitte im Textformat senden. Sch**** auf Corporate-Design. :wink: Oder Anhänge generell als ZIP-Archiv anfordern.
Benutzeravatar
mumpel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8155
Registriert: 09. Jan 2005, 15:20
Wohnort: Lindau (B)

Re: Ablage von Anhängen

Beitragvon mmarkus » 16. Mai 2017, 12:42

Wenn das Bild im HTML Body angezeigt wird, sollte man es auch dort finden.
Ein Prüfung könnte so aussehen:

Code: Alles auswählen
For i = 1 To intAnlagen
    'Anlagen im vordefinierten Verzeichnis sichern
    If InStr(1, .HTMLBody, "cid:" & .Attachments.Item(i).FileName) = 0 Then
        .Attachments.Item(i).SaveAsFile strPath & "\" & Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
    End If
Next i
ms access what else
mmarkus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 1682
Registriert: 16. Apr 2012, 16:07
Wohnort: Oberösterreich

Re: Ablage von Anhängen

Beitragvon Michael Bauer » 16. Mai 2017, 14:19

tarje,
ein bißchen Mitdenken ist hier nicht verboten. Schau Dir das von Rene gezeigte Beispiel an und überlege, warum z.B. 'jpg' gespeichert wird.
Michael Bauer
Add-Ins für Microsoft Outlook
Benutzeravatar
Michael Bauer
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6378
Registriert: 03. Feb 2005, 15:07
Wohnort: Vollersode

Re: Ablage von Anhängen

Beitragvon Tarje_089 » 17. Mai 2017, 10:14

Hallo Michael,

das jpg-Dateien bei Renes Makro gespeichert werden ist mir durchaus bewusst und habe ich auch so hingeschrieben.
Mir ging es darum, dass ich nur jpg und jpeg Dateien aus dem Anhang speichern möchte und eben nicht die Icons aus der Signatur.

Gruß
Tarje
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon Michael Bauer » 17. Mai 2017, 10:39

Hallo,

pardon, das hatte ich übersehen.

Dann ist Markus Ansatz richtig. Du mußt im HTMLBody nach allen cid:* suchen, aber der Wert hinter cid: ist nicht der Name der Anlage. Stattdessen findest Du den Wert in der Eigenschaft PR_ATTACH_CONTENT_ID_W (DASL-Name: http://schemas.microsoft.com/mapi/proptag/0x3712001F). Die Eigenschaft kannst Du über Atttachment.PropertyAccessor lesen.
Michael Bauer
Add-Ins für Microsoft Outlook
Benutzeravatar
Michael Bauer
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6378
Registriert: 03. Feb 2005, 15:07
Wohnort: Vollersode

Re: Ablage von Anhängen

Beitragvon Tarje_089 » 18. Mai 2017, 07:03

Hallo Zusammen,

ich hatte zwischenzeitlich folgende Lösung gefunden:
Leider erhalte ich immer die Meldung "Fehler beim Kompilieren, Erwartet: then oder GoTo"

Code: Alles auswählen
Sub Anlage_verschieben()
Dim strPath As String
Dim objMail As MailItem
Dim intAnlagen As Integer, i As Integer
On Error Resume Next
'Pfad zu meinem Ordner
strPath = "L:\Testordner"
'Schleife
For Each objMail In Outlook.ActiveExplorer.Selection
With objMail
'Mails auf vorh. Anlagen prüfen
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
For i = 1 To intAnlagen
'Bilder auschließen
If Right(.Attachments.Item(i).DisplayName, 3) "jpg" and Right(.Attachments.Item(i).DisplayName, 3) "bmp" and .Attachments.Item(i).Size < 1000 Then
End If
'Anlagen im vordefinierten Verzeichnis sichern
.Attachments.Item(i).SaveAsFile strPath & "\" & Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
Next i
End If
End With
Next objMail
End Sub
Zuletzt geändert von Tarje_089 am 18. Mai 2017, 08:22, insgesamt 1-mal geändert.
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon mumpel » 18. Mai 2017, 07:29

Zu Ersten fehlen in der Zeile "If Right(...)" ein paar Gleicheitszeichen. Zum Zweiten wird trotzdem alles gespeichert da die Zeile zum Speichern außerhalb der If-Abfrage steht.

Code: Alles auswählen
For i = 1 To intAnlagen
    If Right(.Attachments.Item(i).DisplayName, 3) = "jpg" And _
       Right(.Attachments.Item(i).DisplayName, 3) = "bmp" And _
      .Attachments.Item(i).Size < 1000 Then
    Else
      .Attachments.Item(i).SaveAsFile strPath & "\" & _
      Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
    End If
Next i
Benutzeravatar
mumpel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8155
Registriert: 09. Jan 2005, 15:20
Wohnort: Lindau (B)

Re: Ablage von Anhängen

Beitragvon Tarje_089 » 18. Mai 2017, 08:21

Ich habe deine Anmerkung eingesetzt, nur bleibt es weiterhin dabei, dass alle Dateien abgespeichert werden...

Code: Alles auswählen
Sub Anlage_verschieben_Test()
Dim strPath As String
Dim objMail As MailItem
Dim intAnlagen As Integer, i As Integer
On Error Resume Next
'Pfad zu meinem Ordner
strPath = "L:\Testordner"
'Schleife
For Each objMail In Outlook.ActiveExplorer.Selection
With objMail
'Mails auf vorh. Anlagen prüfen
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
For i = 1 To intAnlagen
    If Right(.Attachments.Item(i).DisplayName, 3) = "jpg" And _
       Right(.Attachments.Item(i).DisplayName, 3) = "png" And _
      .Attachments.Item(i).Size < 50 Then
      Else
      .Attachments.Item(i).SaveAsFile strPath & "\" & _
      Format(.ReceivedTime, "yyyy-mm-dd_hh-mm") & " " & .Attachments.Item(i).FileName
    End If
Next i
End If
End With
Next objMail
End Sub
Tarje_089
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 05. Mai 2017, 08:17

Re: Ablage von Anhängen

Beitragvon DerHoepp » 20. Mai 2017, 23:14

Hallo,

Code: Alles auswählen
If Right(.Attachments.Item(i).DisplayName, 3) = "jpg" And _
       Right(.Attachments.Item(i).DisplayName, 3) = "png" ...

ist ziemlich sinnlos, oder? gleichzeitig jpg und png wird nur sehr selten vorkommen (nur, wenn du das Spiegelneuron im richtigen moment triffst (und nicht hinguckst, frag Schrödinger!)).

Gruß
derHöpp
DerHoepp
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8419
Registriert: 14. Mai 2013, 11:08

Nächste

Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste