mreske
Goto Top

Outlook mit VBA - Mailanhang in Ordner abspeichern, wobei der Betreff der Dateiname sein soll

Hallo Forumexperten,
ich bin im Internet auf dieses Forum gestossen und habe zuerst nur BIBER direkt angemailt.
Auf Bibers Rat hin veröffentliche ich hier nun mein Anliegen, damit alle Forummitglieder etwas von der Lösung des Problems haben. Das ist mein erster Beitrag.

Ich bekomme täglich sehr viele emails von unserer Hauptgeschäftsstelle mit Rechnungsanhängen als PDF.

1. Ich möchte gerne die PDF Anhänge in einem dafür vorgesehenen Ordner ablegen, was bereits funktioniert.(siehe VBA-Makro unten)
Dazu hatte mir folgender Beitrag schon sehr weitergeholfen: Outlook 2003: Datei aus Mailanhang automatisch in Ordner verschieben oder kopieren

PROBLEM:
Leider ist der Name der jeweiligen PDF Datei NICHT die Rechnungnummer, sondern eine fortlaufende Nummer, die vom System unserer Geschaftsstelle automatisch vergeben wird.

Ich muss die PDF Datei aber als Rechnungsnummer abspeichern. Diese Rechnungsnummer finde ich im Betreff der jeweiligen Mail.
Z.B.: VAUDE-Factura 61854816

FRAGE:
Wie kann ich nun die PDF Datei mit dem Betreff der Mail als Dateinamen abspeichern.
Oder noch komplizierter: Wie kann ich NUR die Rechnungsnummer (ohne "Vaude-Factura") also nur 61854816.pdf als Dateinamen abspeichern?

Hier einmal mein bereits vorhandener VBA CODE:

Sub Application_NewMail()
Dim strNewFolder As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim oAttachment As Attachment

strNewFolder = "W:\VBA_TEST\"
On Error GoTo check_error
MkDir strNewFolder
Back1:
Set objPosteingang =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objPosteingang.Items
If Item.Class = olMail Then
Set objNewMail = Item
With objNewMail

If .UnRead = True Then

intanlagen = .Attachments.Count
Debug.Print objNewMail & ": "; intanlagen If intanlagen > 0 Then For i = 1 To intanlagen Set oAttachment = .Attachments.Item(i) oAttachment.SaveAsFile strNewFolder & "\" & oAttachment.FileName

Next i
End If
End If
End With
End If
Next Item

check_error:
Debug.Print Err.Number; Err.Description
If Err.Number = 75 Then ' Fehler beim Zugriff auf Pfad -- ignorieren wir mal Err.Clear

GoTo Back1:
Else
'Err.Raise Err.Number, Err.Description

End If
Err.Clear
Resume Next

End Sub


Ich hoffe, Ihr könnt mir bei der Lösung behilflich sein.

Viele Grüsse aus Spanien
Manfred
Kommentar vom Moderator Biber am 02.07.2009 um 18:49:23 Uhr
Ich hab den Beitrag mal von "BASIC" nach "Outlook" verschoben.
Und auf gelöst gesetzt.

Content-Key: 119586

Url: https://administrator.de/contentid/119586

Ausgedruckt am: 29.03.2024 um 02:03 Uhr

Mitglied: 49097
49097 02.07.2009 um 10:44:05 Uhr
Goto Top
Hallo Manfred,

sieht denn die Betreff-Zeile immer so aus, oder kann sich die Rechnungsnummer irgendwo verstecken?
Könntest Du ein paar mehr von diesen Betreffzeilen posten, damit man eventuell Gemeinsamkeiten sehen könnte?

Gruss

dsmg500
Mitglied: mreske
mreske 02.07.2009 um 16:24:54 Uhr
Goto Top
Hallo dsmg500,
die Betreffzeile sieht IMMER so aus, nur die Rechnungsnummer ändert sich selbstverständlich:

Hier ein paar Beispiele:

VAUDE-Factura 61854816
VAUDE-Factura 61854817
VAUDE-Factura 61854815
VAUDE-Factura 61854814
VAUDE-Factura 61854812

usw......

Mir würde es natürlich auch reichen, wenn die PDF Datei mit dem kompletten Betreff (also z.B.: VAUDE-Factura 61854812.pdf) gespeichert wird, aber dennoch würde mich interessieren, wie man das "VAUDE-Factura " rausfiltert.

Bin überrascht dass so schnell auf meinen Beitrag geantwortet wird. Ich glaube ich stelle hier öfter mal was rein.

Beste Grüsse
Manfred
Mitglied: 49097
49097 02.07.2009 um 16:57:00 Uhr
Goto Top
Hallo Manfred,

wenn die Zeile immer so aussieht, dann könnte es so klappen:

Dim strNewFolder As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim oAttachment As Attachment
Dim ts() as String

strNewFolder = "W:\VBA_TEST\"  
On Error GoTo check_error
MkDir strNewFolder
Back1:
Set objPosteingang =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each Item In objPosteingang.Items
If Item.Class = olMail Then
Set objNewMail = Item
With objNewMail

If .UnRead = True Then

intanlagen = .Attachments.Count

'Hier die Betreffzeile der Mail lesen und dann nach Factura trennen  
ts=split(objnewmail.subject ,"Factura")  
'dann sollte in ts(1) die Rechnungsnummer mit einem Leerzeichen stehen  

Debug.Print objNewMail & ": "; intanlagen If intanlagen > 0 Then For i = 1 To intanlagen Set oAttachment = .Attachments.Item(i) oAttachment.SaveAsFile strNewFolder & "\" & trim(ts(1)) & ".pdf"  

Next i
End If
End If
End With
End If
Next Item

check_error:
Debug.Print Err.Number; Err.Description
If Err.Number = 75 Then ' Fehler beim Zugriff auf Pfad -- ignorieren wir mal Err.Clear  

GoTo Back1:
Else
'Err.Raise Err.Number, Err.Description  

End If
Err.Clear
Resume Next

End Sub

Ich hoffe, das klappt so unter VBA!

Gruss

dsmg500
Mitglied: mreske
mreske 02.07.2009 um 18:32:54 Uhr
Goto Top
Hallo dsmg500,
tausend dank - es funktioniert - und das beim ersten Versuch.

Super Forum - besten Dank (auch an Frank (Bieber)

Hier in Barcelona kann´ste Spiegeleier auf der Strasse braten. Da bleibe ich lieber im kühlen Büro und lass mir noch mal Euer Marko durch den Kopf gehen.

Macht´s gut
Saludos
Manfred
Mitglied: 49097
49097 02.07.2009 um 18:43:21 Uhr
Goto Top
Dann viel Spaß und Danke für die Rückmeldungface-smile
Mitglied: crashzero2000
crashzero2000 03.07.2009 um 09:45:08 Uhr
Goto Top
Hy,

ja, ging mir genauso, heute ein Problem mit VBS gehabt , Minuten später eine Lösung die auch sofort funktionierte.
Ist wirklich genial hier ....

Auch Bastla ist echt super
Dank auch an dsmg500