Outlook 2010 VBA: Mails dynamisch ablegen - komplette Ordnerstruktur erstellen

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
 
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:
Visual Basic: 
...
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 :-(
 
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:
Visual Basic: 
...
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
 
Zuletzt bearbeitet:
_opiWahn_ hat gesagt.:
Warum ich's aber gleich zweimal brauche verstehe ich noch nicht so ganz:
Visual Basic: 
  If InStr(1, f.folderPath, "Posteingang") Then
    *schnipp*
    If UBound(tmpPath) > 0 Then
        ReDim arrPath(UBound(tmpPath))
        *schnipp*
    End If
    
  ElseIf InStr(1, f.folderPath, "Gesendete Elemente") Then
    *schnipp*
    If UBound(tmpPath) > 0 Then
        ReDim arrPath(UBound(tmpPath))
        *schnipp*
    End If
  End If
    *schnipp*
Zum Vergrößern anklicken....


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.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück