gesendete objekte

  • Sonstige

    gesendete objekte

    moin moin
    ich habe eine kleine problemchen
    habe sortierung in outlook 2002 mit vba von ordner "gesendete objekte" vorgenommen.
    sortierung läuft folgdner masse:
    jede abgesendete mail wird nach empfänger adresse sortiert..und die gleiche werden in ein ordner geschoben (mit gleichem name, wenn solche ordner nicht existiert dann wird ein erstellt).. wenn ein mail (email adresse ) mit angezeigter name versehen ist funktioniert es ganz gut.. aber wenn es einfach eine emal steht dann kriege ich fehlermeldung nr:2147352567 ... (wie ich es verstanden habe - datensatz ist nicht im system). ich habe das umgehen können und die mails übersprungen.. aber dann bleiben die unsortiert...
    hat jemand eine idee wie ich miene programm dazu bringe die mails die nicht in system sind auch abzuspeichern (zb im ersteltem ordner - ungeordnete)
    für jede hilfe stellung bedanke ich mich im voraus...



    ps hier ist der Codeausschnitt:

    Sub GOSortieren1()

    Dim i As Integer
    Dim j As Integer
    Dim oMail As MailItem
    Dim schonda As Boolean
    Dim Name As Variant
    schonda = False


    Set myOlApp = CreateObject("Outlook.Application")
    Set MyNameSpace = myOlApp.GetNamespace("MAPI")
    Set myinbox = MyNameSpace.GetDefaultFolder(olFolderSentMail)
    Set MyFolder = myinbox.Folders
    Set MyItems = myinbox.Items

    Call HOfürGesObSort
    'hier wird eine prozedur aufgerufen mit die ich haupt ordner erstelle ... alles weiteres wird als unterordner gespeichert...

    If olFolderInbox > 0 Then
    j = myinbox.Items.Count
    Do While j > 0
    Set oMail = myinbox.Items(j)

    If UCase(Left(oMail.To, 2)) = "KA" Then
    Name = "Kappa"
    Else
    .....
    End If
    With Application.GetNamespace("MAPI")
    Set myTasks = MyNameSpace.GetDefaultFolder(olFolderSentMail)
    Set MyFolder = myTasks.Folders(Name)
    End With


    '************************
    For Each fld In MyFolder.Folders
    'On Error GoTo errors:
    If fld.Name = oMail.To Then
    schonda = True
    Set myNameFolder = MyFolder.Folders
    myNameFolder = fld.Name
    Set myNameFolder = MyFolder.Folders(oMail.To)
    Exit For
    End If
    Next
    If Not schonda Then
    '***********************
    prompt$ = "Möchten Sie ein Ordner für " & oMail.To & " Absender erstellen?"
    Reply = MsgBox(prompt$, vbYesNo, Abfrage)
    If Reply = vbNo Then
    j = j - 1


    GoTo WeitereMail
    End If

    Set myNameFolder = MyFolder.Folders.Add(oMail.To)
    End If

    Set myitem = MyItems.Find("[An] ='" & myNameFolder & "'")

    While TypeName(myitem) <> "Nothing"
    myitem.Move myNameFolder
    Set myitem = MyItems.FindNext
    j = j - 1
    Wend
    WeitereMail:
    Loop

    Else
    MsgBox "Ordner Gesendete Objekten ist leer"
    End If
    GoTo alles
    errors:
    MsgBox "Um weiter machen zu können mussen Sie den Zugrif gewährleisten..Prozedur wird abgebrochen"
    alles:
    MsgBox "Die Objekte deren EMailadressen sich nich in Datenbank befinden sind ungeordnet geblieben"
    End Sub