Outlook VBA: Ordner mit Prefix erstellen

[amn.ssy]

Hi,

aktuell versuche ich gerade beim Erstellen von Ordner ein Prefix wie [F] für Folder und [P] für Personell voranzustellen.
Für [P] klappt das ganz wie es soll, für [F] aber nur bedingt :-(
Liegt der Ordner direkt unterhalb von Posteingang (\Sonstiges) wird dieser zwar angelegt, aber direkt darunter ein weiterer der nur [F] beinhaltet.
Damit ist das Makro dann auch nicht mehr in der Lage die Mail abzulegen.
Lege ich eine Mail aus \Sonstiges\Blablub ab funktioniert das ganze und es werden beide Ordner jeweils mit dem vorangestellten Prefix [F] angelegt.
Wo liegt der Fehler?

    ReDim Preserve arrPath(UBound(tmpPath))
    If UBound(arrPath) > 0 Then
        For i = LBound(arrPath) To UBound(arrPath)
            strBackupPath = fso.BuildPath(strBackupPath, PREXF & arrPath(i))
                If Not fso.FolderExists(strBackupPath) Then
                    fso.CreateFolder (strBackupPath)
                End If
        Next i
    End If

Grüße und schönes Wochenende
opiwahn

Update:
Hab mir den Codeteil übers WE nochmal angeschaut und komme zu dem Schluss, daß ich entweder das falsche Schleifenkonstrukt benutze oder das Array
ein Element mehr enthält als ich benötige. Meine Versuche in Zeile 3 nach UBound eine -1 zu setzen scheiterten genauso wie ein -1 in Zeile 4 nach arrPath(i).
In deisem Zusammenhang habe ich gerade noch entdeckt, daß ich mit nachfolgedem Codeteil hinsichtlich der Ordnertiefe ziemlich beschränkt bin. Bei 2 Ordner ist Schluß. Wie kann ich diese Beschränkung (vermutl. in Zeile 9) auflösen?

Set f = obj.Parent
  If InStr(1, f.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = f.folderPath
    tmpPath = Split(strPath, "\Posteingang\")
    If UBound(tmpPath) > 0 Then
        ReDim arrPath(UBound(tmpPath))
        Debug.Print tmpPath(1)
        arrPath = Split(tmpPath(1), "\")
    End If

 

[amn.ssy]

Hallo,

Teil 1 Thema Präfix konnte ich nun doch recht einfach lösen:

If UBound(arrPath) > 0 Then
        For i = LBound(arrPath) To UBound(arrPath)
            If arrPath(i) <> "" Then
                strBackupPath = fso.BuildPath(strBackupPath, PREXF & arrPath(i))
                    If Not fso.FolderExists(strBackupPath) Then
                        fso.CreateFolder (strBackupPath)
                    End If
            End If
         Next i
    End If

Einfach mit Zeile 3 abprüfen ob im Array-Element was drin steht.
Bis dahin funktionierts
Die hohe Schule des Programmierens ist's sicher nicht und ich hab auch keine Ahnung ob ich dann noch über was anderes stolpere.
Wir werden sehn...
Zum Teil 2 (mehrer Ordner) versuche ich gerade das hierm was mir aber je nach einstiegspunkt einen Typen- oder Indexfehler bring:

Set f = obj.Parent
  If InStr(1, f.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = f.folderPath
    tmpPath = Split(strPath, "\Posteingang\")
    If UBound(tmpPath) > 0 Then
        ReDim arrPath(UBound(tmpPath))
        For i = LBound(tmpPath) To UBound(tmpPath)
            arrPath(i) = Split(tmpPath(1), "\")
        Next i
    End If

Grundsätzlich müßte es doch in diese Richtung (Zeile 8-10) gehen - oder?
Was ich erreichen möchte ist, daß in jedem arrPath-Element ein Teil des Gesamtpfades steht.

Grüße
opiwahn

 

[Zvoni]

Zeile 9 sieht mir seltsam aus.

Hätte eher sowas erwartet:

tmpPath = Split(strPath, "\Posteingang\")
    If UBound(tmpPath) > 0 Then
        arrPath=Split(tmpPath(1),"\")
        For i = LBound(arrPath) To UBound(arrPath)
            Debug.Print arrPath(i)
        Next i
    End If