# Outlook 2010 VBA: Mails dynamisch ablegen - komplette Ordnerstruktur erstellen



## amn.ssy (30. Januar 2014)

Hallo,

ich komme nochmal zurück auf das erstellen einer kompletten Ordnerstruktur bei der ablage der mails auf der NAS.
Es hat sich herausgestellt, daß ich wohl doch nicht auf ggf. vorhandenen Herkunfts-\Unterrordner verzichten kann.
Aktuelle sieht das im Kern so aus:

```
Private Function ProcessEmail(myItem As Object, ByVal strBackupPath As String) As Variant
    'Saves the e-mail on the drive by using the provided path.
    'Returns TRUE if successful, and FALSE otherwise.

    Const PROCNAME As String = "ProcessEmail"

    On Error GoTo ErrorHandler

    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim obj As Object: Set obj = Application.ActiveWindow
    Dim F As Outlook.MAPIFolder
    Dim myMailItem As MailItem
    Dim strFolder As String
    Dim strSubFolder As String
    Dim strFolderDate As String
    Dim strFileDate As String
    Dim strSender As String
    Dim strReceiver As String
    Dim strSubject As String
    Dim strFinalFileName As String
    Dim strFullPath As String
    Dim vExtConst As Variant
    Dim vTemp As String
    Dim strErrorMsg As String
    
    If TypeOf myItem Is MailItem Then
         Set myMailItem = myItem
    Else
        Error 1001
    End If
    
    
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  Set F = obj.Parent
  If InStr(1, F.folderPath, "Posteingang") Then
    strFolder = "InBox"
    Debug.Print F.folderPath
    Debug.Print F.Name
  ElseIf InStr(1, F.folderPath, "Gesendete Elemente") Then
    strFolder = "Send"
    Debug.Print F.folderPath
    Debug.Print F.Name
  End If
  
  'strSubFolder =
     
    'Set filename
    strFolderDate = Format(myMailItem.ReceivedTime, EXM_OPT_FOLDERNAME_DATEFORMAT)
    strFileDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
    strSender = myMailItem.SenderName
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
    strSubject = myMailItem.Subject
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strFileDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = CleanString(strFinalFileName)
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolderDate)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strFolder = "InBox" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSender)
    Else
        strBackupPath = fso.BuildPath(strBackupPath, strReceiver)
    End If
    
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If

    strFullPath = fso.BuildPath(strBackupPath, strFinalFileName)
    
    'Save as msg or txt?
    Select Case UCase(EXM_OPT_MAILFORMAT)
        Case "MSG":
            strFullPath = strFullPath & ".msg"
            vExtConst = olMSG
        Case Else:
            strFullPath = strFullPath & ".txt"
            vExtConst = olTXT
    End Select
    'File already exists?
    If fso.FileExists(strFullPath) = True Then
        Error 1002
    End If
    
    'Save file
    myMailItem.SaveAs strFullPath, vExtConst
    
    'Return true as everything was successful
    ProcessEmail = True
...
```
Auf der "Platte" wird dann folgende Struktur erzeugt

```
Z:\Mailarchive
    Inbox
       2014-01-29
          Mueller, Lieschen
               [09-05] [Mueller, Lieschen to Kurz, Eva] [mer gehts net guut ...].msg
```
Kommt diese Mail aus einem Unterordnern wie "Posteingang\Sonstiges\Prosa" würde ich die Mail gerne so ablegen 

```
Z:\Mailarchive
    Inbox
       Sonstiges
           Prosa
              2014-01-29
                  Mueller, Lieschen
                     [09-05] [Mueller, Lieschen to Kurz, Eva] [mer gehts net guut ...].msg
```
Mit F.Folderpath bekomme ich den kompletten Pfad geliefert, der dann etwas so aussieht:

```
\\es.geht@jetzt.net\Posteingang\Sonstiges\Prosa
```
Wie kann ich damit ggf. einen Subfolder zusammenbauen oder ist das der völlig falsche Ansatz und geht geht sogar noch einfacher?
Letztlich brache ich nur das was ggf. nach Posteingang oder Gesendete Elemente kommt.
Postboxeigentümer ist ziemlich wurscht (es sei denn ich hätte mehrere PB's im Outlook - dann wirds spannend) und Posteingang\Ausgang hab ich ja bereits.

LG
opiwahn


----------



## Zvoni (30. Januar 2014)

```
Dim arrPath() As String
Dim Pfad As String

Pfad ="\\es.geht@jetzt.net\Posteingang\Sonstiges\Prosa"

arrPath=Split(Pfad, "\Posteingang\")
```

Führ den Code mal aus, und schau dir mal an was nach dem Split in arrPath(1) steht


----------



## amn.ssy (30. Januar 2014)

Hallo Zvoni,

danke für den Hinweis, der zumindest für die erste Ebene unterhalb von z.B. Posteingang funktioniert. Scheinbar muß ich aber alle Ebenen aufsplitten, da das makro ab der 2. Ebene auf den Bauch fällt - scheinbar kann ich eine Pfad wie \Sonstiges\Prosa nicht in einem Stück umsetzen.
Umgesetzt habe ich es bisher so:

```
Set F = obj.Parent
  If InStr(1, F.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = F.folderPath
    arrPath = Split(strPath, "\Posteingang")
    strSubFolder = arrPath(1)
    Debug.Print strSubFolder
    
  ElseIf InStr(1, F.folderPath, "Gesendete Elemente") Then
    strFolder = "Send"
    strPath = F.folderPath
    arrPath = Split(strPath, "\Gesendete Elemente")
    strSubFolder = arrPath(1)
    Debug.Print strSubFolder
  End If
...
strBackupPath = fso.BuildPath(strBackupPath, strFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strSubFolder <> "" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSubFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    End If
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolderDate)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strFolder = "InBox" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSender)
    Else
        strBackupPath = fso.BuildPath(strBackupPath, strReceiver)
    End If
    
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If

    strFullPath = fso.BuildPath(strBackupPath, strFinalFileName)
```


----------



## Zvoni (30. Januar 2014)

```
Dim tmpPath() As String
Dim arrPath() As String
Dim Pfad As String
 
Pfad ="\\es.geht@jetzt.net\Posteingang\Sonstiges\Prosa"
 
tmpPath=Split(Pfad, "\Posteingang\")
arrPath=Split(tmpPath(1),"\")
```

jetzt haste in arrPath(0) = "Sonstiges"
in arrPath(1) = "Prosa"
in arrPath(2), arrPath(3) usw. eventuell weitere vorhandene Ordner unterhalb von "Prosa"


----------



## amn.ssy (30. Januar 2014)

Hallo Zvoni,

hab gerade versucht mir sowas zu bauen:

```
Set F = obj.Parent
  If InStr(1, F.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = F.folderPath
    tmpPath = Split(strPath, "\Posteingang\")
    arrPath = Split(tmpPath(1), "\")
    
        For i = LBound(arrPath) To UBound(arrPath)
            If arrPath(i) <> "" Then
                arrSubFolder(i) = arrPath(i)
            End If
        Next i
        Debug.Print arrSubFolder(i)
```
Aber da harkts noch ein wenig:
Die Zeile arrPath = Split(tmpPath(1), "\") wird angemeckert weil ein datenfeld erwartet wird.
Schmeiss ich die (1) raus krachts wg. Typenunverträglickeit bzw. beim debuggen hab ich gesehen, daß er erst garnicht über die Zeile raus kommt


----------



## Zvoni (30. Januar 2014)

Kannst du mal den Deklarationsteil zeigen wo du die variablen deklarierst?


----------



## amn.ssy (30. Januar 2014)

gerade in dem Moment als ich den Deklarationsteil kopieren wollte hab ich gesehen, daß bei tmpPath die () fehlten und das ganze somit kein Array war.
Dafür ist jetzt der Idex außerhalb des gültigen Bereichs.
Gleiche Stelle - zur Schleife kommt er erst garnicht.

```
Private Function ProcessEmail(myItem As Object, ByVal strBackupPath As String) As Variant
    'Saves the e-mail on the drive by using the provided path.
    'Returns TRUE if successful, and FALSE otherwise.

    Const PROCNAME As String = "ProcessEmail"

    On Error GoTo ErrorHandler

    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim obj As Object: Set obj = Application.ActiveWindow
    Dim F As Outlook.MAPIFolder
    Dim myMailItem As MailItem
    Dim strPath As String
    Dim tmpPath() As String
    Dim arrPath() As String
    Dim strFolder As String
    Dim arrSubFolder() As String
    Dim strFolderDate As String
    Dim strFileDate As String
    Dim strSender As String
    Dim strReceiver As String
    Dim strSubject As String
    Dim strFinalFileName As String
    Dim strFullPath As String
    Dim vExtConst As Variant
    Dim vTemp As String
    Dim strErrorMsg As String
    Dim i As Integer
    
    If TypeOf myItem Is MailItem Then
         Set myMailItem = myItem
    Else
        Error 1001
    End If
    
    
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  
  Set F = obj.Parent
  If InStr(1, F.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = F.folderPath
    tmpPath = Split(strPath, "\Posteingang\")
    arrPath = Split(tmpPath(1), "\")
    
    Debug.Print arrPath(0)
    Debug.Print arrPath(1)
    Debug.Print arrPath(2)
    
        For i = LBound(arrPath) To UBound(arrPath)
            If arrPath(i) <> "" Then
                arrSubFolder(i) = arrPath(i)
            End If
            Debug.Print arrSubFolder(i)
        Next i
        
  ElseIf InStr(1, F.folderPath, "Gesendete Elemente") Then
    strFolder = "Send"
    strPath = F.folderPath
    tmpPath = Split(strPath, "\Gesendete Elemente\")
    arrPath = Split(tmpPath(1), "\")
    arrSubFolder(0) = arrPath(0)
    Debug.Print arrSubFolder(0)
  End If
       
    'Set filename
    strFolderDate = Format(myMailItem.ReceivedTime, EXM_OPT_FOLDERNAME_DATEFORMAT)
    strFileDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
    strSender = myMailItem.SenderName
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
    strSubject = myMailItem.Subject
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strFileDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = CleanString(strFinalFileName)
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If arrSubFolder(0) <> "" Then
        strBackupPath = fso.BuildPath(strBackupPath, arrSubFolder(0))
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    End If
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolderDate)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strFolder = "InBox" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSender)
    Else
        strBackupPath = fso.BuildPath(strBackupPath, strReceiver)
    End If
    
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If

    strFullPath = fso.BuildPath(strBackupPath, strFinalFileName)
    
    'Save as msg or txt?
    Select Case UCase(EXM_OPT_MAILFORMAT)
        Case "MSG":
            strFullPath = strFullPath & ".msg"
            vExtConst = olMSG
        Case Else:
            strFullPath = strFullPath & ".txt"
            vExtConst = olTXT
    End Select
    'File already exists?
    If fso.FileExists(strFullPath) = True Then
        Error 1002
    End If
    
    'Save file
    myMailItem.SaveAs strFullPath, vExtConst
    
    'Return true as everything was successful
    ProcessEmail = True

ExitScript:
    Exit Function
ErrorHandler:
    Select Case Err.Number
    Case 1001:  'Not an email
        ProcessEmail = EXM_013
    Case 1002:
        ProcessEmail = EXM_014
    Case 1003:
        ProcessEmail = strErrorMsg
    Case Else:
        ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
    End Select
    Resume ExitScript
End Function
```

Für den Bereich der ausgehenden mails hab ich erst mal was reingesetzt bis dr Posteingang funktioniert. Debug.Print dient mir zur Kontrolle.
Um Zeile 96 bis 101 muß ich dann wohl auch noch ne Schleife bauen? Irgendwie muß ich das Array ja durchlaufen und für jedes vorhandene Element einen Ordner erstellen wenn er noch nicht vorhanden ist.


----------



## Zvoni (30. Januar 2014)

Zeile 46+47: Kannst du mal die Werte für strPath und tmpPath(0) und tmpPath(1) hier reinstellen?
Ich habe da ne Vermutung....


----------



## amn.ssy (30. Januar 2014)

strPath: \\xxx.yyy@zzz.com\Posteingang\09 Other\Test
tmpPath(0):\\xxx.yyy@zzz.com
tmpPath(1):09 Other\Test

Sieht soweit richt aus ...


----------



## Zvoni (30. Januar 2014)

hmmm...

Nach dem zweite Split müsste dann das Ergebnis doch so aussehen:

arrPath(0) = 09 Other
arrPath(1) = Test

und Debug.Print arrPath(2) wirft dir einen ungültigen Index an den Kopf, da arrPath(2) nicht existiert. Kommentier das mal aus. Setz lieber mal einen Breakpoint auf Zeile 45 und schau dir mal die Ergebnisse im Überwachungsfenster an.

Ansonsten kann ich hier keinen Fehler sehen. LBound To UBound ist definitiv die richtige Herangehensweise.

Was Zeile 96 betrifft: Ja. Da brauchste ne Schleife

EDIT: Falls ich mal Zeit haben sollte, schau ich mal ob ich dir das ganze per API's zusammenbauen kann *gg*
Ich kann so ein Gehangel durch den Ordnerbaum nunmal auf den Tod nicht ausstehen


----------



## amn.ssy (30. Januar 2014)

das mit dem Überwachungsfenster sollte ich mir angewöhnen ...
Index von arrSubFolder(i) ist von vornherein außerhalb des gültigen Bereichs und daran ändert sich auch nicht wenn's in die Schleife geht


----------



## Zvoni (30. Januar 2014)

Ich sehe nirgends ein ReDim arrSubFolder


----------



## amn.ssy (31. Januar 2014)

Jetzt dachte ich schon ich hätte damit den Durchbruch erziehlt (ohne Redim, dessen korrekte Stelle ich vergeblich experimentierte) hab mir dabei aber wohl doch ins Knie geschossen:

```
...
Set F = obj.Parent
  If InStr(1, F.folderPath, "Posteingang") Then
    strFolder = "InBox"
    strPath = F.folderPath
    tmpPath = Split(strPath, "\Posteingang\")
    arrPath = Split(tmpPath(1), "\")
         
  ElseIf InStr(1, F.folderPath, "Gesendete Elemente") Then
    strFolder = "Send"
    strPath = F.folderPath
    tmpPath = Split(strPath, "\Gesendete Elemente\")
    arrPath = Split(tmpPath(1), "\")
  End If
    
    'Set filename
    strFolderDate = Format(myMailItem.ReceivedTime, EXM_OPT_FOLDERNAME_DATEFORMAT)
    strFileDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
    strSender = myMailItem.SenderName
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
    strSubject = myMailItem.Subject
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strFileDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = CleanString(strFinalFileName)
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    For i = LBound(arrPath) To UBound(arrPath)
        If arrPath(i) <> "" Then
            strBackupPath = fso.BuildPath(strBackupPath, arrPath(i))
                If Not fso.FolderExists(strBackupPath) Then
                    fso.CreateFolder (strBackupPath)
                End If
        End If
    Next i
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolderDate)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strFolder = "InBox" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSender)
    Else
        strBackupPath = fso.BuildPath(strBackupPath, strReceiver)
    End If
    
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If

    strFullPath = fso.BuildPath(strBackupPath, strFinalFileName)
...
```
Das ergebnis ist, daß ich jetzt nur noch Mails ablegen kann, wenn Sie aus min. einem (Unter)Ordner kommen :-(


----------



## amn.ssy (4. Februar 2014)

Morgähn,

so nun ist's komplett  
Wie "Zvoni" schon zuvor anmerkte kam ich letztlich nicht am Redim vorbei.
Warum ich's aber gleich zweimal brauche verstehe ich noch nicht so ganz:

```
...
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))
        arrPath = Split(tmpPath(1), "\")
    End If
    
  ElseIf InStr(1, f.folderPath, "Gesendete Elemente") Then
    strFolder = "Send"
    strPath = f.folderPath
    tmpPath = Split(strPath, "\Gesendete Elemente\")
    If UBound(tmpPath) > 0 Then
        ReDim arrPath(UBound(tmpPath))
        arrPath = Split(tmpPath(1), "\")
    End If
  End If
    
    'Set filename
    strFolderDate = Format(myMailItem.ReceivedTime, EXM_OPT_FOLDERNAME_DATEFORMAT)
    strFileDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
    strSender = myMailItem.SenderName
    strReceiver = myMailItem.To 'All receiver, semikolon separated string
    If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
    strSubject = myMailItem.Subject
    strFinalFileName = EXM_OPT_FILENAME_BUILD
    strFinalFileName = Replace(strFinalFileName, "<DATE>", strFileDate)
    strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
    strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
    strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
    strFinalFileName = CleanString(strFinalFileName)
    If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
        strErrorMsg = Mid(strFinalFileName, 16, 9999)
        Error 1003
    End If
    strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolder)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    ReDim Preserve arrPath(UBound(tmpPath))
    If UBound(arrPath) > 0 Then
        For i = LBound(arrPath) To UBound(arrPath)
            strBackupPath = fso.BuildPath(strBackupPath, arrPath(i))
                If Not fso.FolderExists(strBackupPath) Then
                    fso.CreateFolder (strBackupPath)
                End If
        Next i
    End If
    
    strBackupPath = fso.BuildPath(strBackupPath, strFolderDate)
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If
    
    If strFolder = "InBox" Then
        strBackupPath = fso.BuildPath(strBackupPath, strSender)
    Else
        strBackupPath = fso.BuildPath(strBackupPath, strReceiver)
    End If
    
        If Not fso.FolderExists(strBackupPath) Then
            fso.CreateFolder (strBackupPath)
        End If

    strFullPath = fso.BuildPath(strBackupPath, strFinalFileName)
...
```
Geändert haben sich die Zeilen: 7-10, 10-19 und 47 - 49

LG
opiwahn


----------



## Zvoni (4. Februar 2014)

_opiWahn_ hat gesagt.:


> Warum ich's aber gleich zweimal brauche verstehe ich noch nicht so ganz:
> 
> ```
> If InStr(1, f.folderPath, "Posteingang") Then
> ...




Weil du in einem If-ElseIf-Konstrukt bist, und je nach dem in welchem Teil der If-Klausel du landest ist UBound anderst. Von daher absolut logisch dass du es zweimal brauchst.
Alternative wäre mit einer Variablen zu arbeiten und dann den ReDim nach dem If-ElseIf, aber wie heisst es doch so schön: Es funktioniert jetzt, also fass es nicht mehr an.


----------

