|
|
 |
Ich bekomme häufig
E-Mails, in denen Dateien als Anlage eingefügt sind. Um
diese Anlagen zu speichern, markiere ich die Nachricht im Posteingang und
klicke in der Menüleiste Datei
 Anlagen speichern.
Oder
ich öffne die Nachricht und speichere dann mit Datei
Anlagen speichern.
Wie kann ich diesen Vorgang automatisieren? |
|
|
Wie kann ich Anlagen mit einem Klick speichern? Im Outlook 2000/2002
kannst Du mit
Visual Basic für Applikationen viele Ereignisse automatisieren. Verwende
dieses Makro. Es erstellt auf der Festplatte ein Verzeichnis mit
dem Namen des aktuellen Datums und speichert die Attachments
aller markierten Nachrichten in diesem Verzeichnis ab. Die
Dateianhänge werden dabei aus der Mail entfernt. Der Pfad zur
Datei wird in den Body der Mail eingefügt. |
 |
|
|
Die Schritte im Detail.
 |
Rufe mit Alt + F11 den Visual
Basic-Editor auf. |
|
|
Klicke im Projekt-Explorer auf das kleine
Plussymbol vor Projekt1. Der Zweig Microsoft Outlook
Objekte wird eingeblendet. |
|
|
Nun ein Doppelklick auf
DieseOutlookSitzung. |
|
|
Füge nun den unten stehenden Code ein. |
|
|
Option Explicit
Const strBackupPath As String = "C:\"
Sub SaveAttachments()
Dim olExplorer As Explorer
Dim olFolder As MAPIFolder
Dim olSelection As Selection
Dim olItem As MailItem
Dim lngAttCount As Long, i As Long
Dim strAttNames As String
Dim strSubDir As String
Dim intAnswer As Integer
Set olExplorer = Application.ActiveExplorer
Set olFolder = Application.ActiveExplorer.CurrentFolder
If olFolder.DefaultItemType = olMailItem Then
Set olSelection = olExplorer.Selection
For Each olItem In olSelection
lngAttCount = olItem.Attachments.Count
If lngAttCount > 0 Then
strAttNames = ""
For i = lngAttCount To 1 Step -1
With olItem.Attachments.Item(i)
strSubDir = strBackupPath & Format(olItem.CreationTime, "yyyymmdd")
If Dir(strSubDir, vbDirectory) = "" Then
MkDir strSubDir
End If
.SaveAsFile strSubDir & "\" & .FileName
strAttNames = strAttNames & "<<" & strSubDir & "\" & .FileName & ">>" & vbCr
.Delete
End With
Next i
With olItem
Select Case .GetInspector.EditorType
Case olEditorText
.Body = "Anlagen gespeichert unter:" & vbCr & strAttNames & String(2, vbCr)
& .Body
Case olEditorHTML
.HTMLBody = "Anlagen gespeichert unter:" & vbCr & strAttNames & String(2,
vbCr) & .HTMLBody
Case olEditorRTF, olEditorWord
intAnswer = MsgBox("Wenn Sie einen Hinweis auf gespeicherte Anlagen
einfügen, " & _
"gehen die Formatierungen der Nachricht verloren!" & vbCr & _
"Wollen Sie den Hinweis trotzdem einfügen?", vbYesNo)
If intAnswer = vbYes Then
.Body = "Anlagen gespeichert unter:" & vbCr & strAttNames & String(2, vbCr)
& .Body
End If
End Select
.Save
End With
End If
Next olItem
Else
MsgBox "In diesem Ordner befinden sich keine E-Mail-Nachrichten."
End If
End SubDer blau markierte Text muss von Dir angepasst werden. Es handelt
sich um den Pfad zum Verzeichnis, in denen die Dateianhänge
gespeichert werden sollen. Trage in der Zeile
Const strBackupPath As String = "C:\"
den von Dir gewünschten Pfad ein.
|
|
Projekt speichern.
|
|
Speichere das Projekt per Datei
VbaProjekt.OTM
speichern. |
|
|
Verlasse den VB-Editor mit Datei
Schließen und zurück
zu Microsoft Outlook |
|
|
Starte Outlook neu. |
|
|
| Dateianhänge speichern Markiere
die Mails deren Attachments gespeichert werden sollen. Mit
Strg + A kannst Du alle Nachrichten im Ordner auswählen.
Starte dann das Makro mit einem Icon in der Symbolleiste.
 MS-Outlook-2000/2
Makro in der Symbolleiste |
 |
|
