Moin,
hier erstmal die VBA-Hilfe:
Add-Methode (Folders-Auflistung)
Erstellt in der Folders-Auflistung einen neuen Ordner und gibt den neuen Ordner als MAPIFolder-Objekt zurück.
Syntax
objFolders.Add(Name, [Type])
objFolders Erforderlich. Ein Ausdruck, der ein Folders -Objekt zurückgibt.
Name Erforderlicher Wert vom Typ String. Der Anzeigename für den neuen Ordner.
Type Optionaler Wert vom Typ Long. Der Outlook-Ordnertyp des neuen Ordners. Wenn kein Ordnertyp angegeben wird, verwendet der neue Ordner standardmäßig denselben Typ wie der Ordner, in dem er erstellt wurde. Folgende OlDefaultFolders-Konstanten sind möglich:
olFolderCalendar(9),
olFolderContacts(10),
olFolderDrafts(16),
olFolderInbox(6),
olFolderJournal(11),
olFolderNotes(12) oder
olFolderTasks(13).
(Die Konstanten olFolderDeletedItems(3), olFolderOutbox(6) und olFolderSentMail(5) können für dieses Argument nicht angegeben werden.)
So, und hier noch ein Beispiel, wie man es machen kann:
Sub ErstelleOrdnerAusListe()
Dim Namensliste As Variant
Dim Einzelname As Variant
If MsgBox("Wirklich neue Ordner innerhalb von '" & \_
ActiveExplorer.CurrentFolder.Name & "' erstellen?", \_
vbQuestion + vbYesNo) vbYes Then
MsgBox "Abgebrochen", vbInformation
Exit Sub
Else 'Wirklich
Namensliste = Array( \_
"A", \_
"B", \_
"C", \_
"")
For Each Einzelname In Namensliste
If ErstelleOrdner(CStr(Einzelname), "ZZ\_Leer") = False Then Exit For
Next 'Einzelname
End If 'Wirklich
End Sub 'ErstelleOrdnerAusListe
Private Function ErstelleOrdner(OrdnerName As String, Optional KopieVon As String) As Boolean
Dim F As MAPIFolder
Dim CF As MAPIFolder
ErstelleOrdner = True
If OrdnerName = "" Then Exit Function
Set CF = ActiveExplorer.CurrentFolder
On Error Resume Next
If KopieVon = "" Then
CF.Folders.Add OrdnerName, olFolderInbox
Else
Set F = CF.Folders(KopieVon).CopyTo(CF) 'Wenn der Ordner "KopieVon"
'nicht existiert, tritt ein
'Fehler auf, und es kommt zur
'Fehlermeldung unten.
F.Name = OrdnerName
Set F = Nothing
OrdnerName = OrdnerName & "' aus '" & KopieVon 'Für Fehlermeldung
End If 'KopieVon
If Err.Number 0 Then
If MsgBox("Beim Versuch, den Ordner '" & \_
OrdnerName & "' zu erstellen, ist ein Fehler aufgetreten." & \_
vbCrLf & vbCrLf & \_
"Mit dem nächsten Ordner fortfahren oder ganz abbrechen?", \_
vbCritical + vbOKCancel) = vbCancel Then
ErstelleOrdner = False
End If
End If 'Err.Number 0
On Error GoTo 0
Set CF = Nothing
End Function 'ErstelleOrdner
Du musst das Ganze in ein VBA-Modul in Outlook kopieren, in den Ordner gehen, in dem die neuen Unterordner erstellt werden sollen und dann das Makro ausführen.
Es gibt hier zwei Möglichkeiten, neue Ordner zu erstellen:
- ganz neu oder
- als Kopie von einem bestehenden Ordner.
Die zweite Variante hat den Vorteil, dass alle Ordner-Einstellungen wie Feldauswahl und Sortierung übernommen werden. Ich würde also einen leeren Ordner „ZZ_Leer“ anlegen, diesen wie gewünscht formatieren und ihn dann immer als Master verwenden. Das ist in dem Beispiel so gemacht. Der Name beginnt übrigens mit „ZZ“, damit der Ordner immer unter die neuen Ordner sortiert wird bei der Ansicht in Outlook.
Probier´s mal aus. Bei Fragen steht das Forum sicher zur Verfügung.
Achso, die Zeilen
"A", \_
"B", \_
"C", \_
kannst Du dann leicht in Excel zusammemschrauben und an dier Stelle dort einfügen.
Kristian
PS: Man könnte das auch als VBS-Skript realisieren, das dann einfach von Windows aus gestartet wird (also nicht als VBA-Makro innerhalb von Outlook selbst). Das erfordert aber noch ein paar Zeilen mehr Code, um den gewünschten Ordner festzulegen undso. Bei der obigen VBA-Variante ist es einfach der aktuelle Outlook-Ordner.
