Hallo habe mir folgendes Makro gebastelt. Ich bekomme es aber absolut nicht hin das die gesendeten Mails nur im Ordner Diagnosen und die eingehenden Mails nur im Ordner Patientendaten gespeichert werden. er speichert beim Senden und empfangen immer in beide Ordner. Kann mir da bitte jemand helfen???

Gruß René

Private Sub Application_NewMailEx _
                     (ByVal EntryIDCollection As String)
    Dim arr() As String
    Dim i As Integer
    Dim ns As Outlook.NameSpace
    Dim itm As MailItem
    Dim m As Outlook.MailItem
    Dim MyBetreff As String


    On Error Resume Next
    Set ns = Application.Session
    arr = Split(EntryIDCollection, ",")

'Mailausgang durchsuchen
    MyBetreff = "Epikrise"
   
    For i = 0 To UBound(arr)
       Set itm = ns.GetItemFromID(arr(i))
       If itm.Class = olMail Then
          Set m = itm

          Set myItem = Application.Session.GetDefaultFolder(olFolderSentItem).Items(1)
          myItem.Display
  
         strname = m.Subject
      
         If InStr(1, strname, MyBetreff) = 0 Then
                myItem.Close olSave
                myItem.UnRead = True
                Exit Sub
         ElseIf InStr(1, strname, MyBetreff) <> 0 Then
                strname = Replace(strname, ":", " ")
                strname = Replace(strname, "/", " ")
                    
          End If
      
          Dim strPrompt As String
          m.SaveAs "Y:\Diagnosen\" & strname & " " & "Datum" & "_" & Day(Date) & "_" _
            & Month(Date) & "_" & Year(Date) & "_" & "Uhrzeit" & "_" & Hour(Time) & "_" _
            & Minute(Time) & ".msg", olMSG

         myItem.Close olSave
         myItem.UnRead = True

       End If
    Next
   
'Posteingang durchsuchen

   MyBetreff = "Epikrise"

   
       For i = 0 To UBound(arr)
      Set itm = ns.GetItemFromID(arr(i))
        If itm.Class = olMail Then
            Set m = itm
   
    
   
          Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
          myItem.Display
   
          strname = m.Subject
      
          If InStr(1, strname, MyBetreff) = 0 Then
                myItem.Close olSave
                myItem.UnRead = True
                Exit Sub
          ElseIf InStr(1, strname, MyBetreff) <> 0 Then
                strname = Replace(strname, ":", " ")
                strname = Replace(strname, "/", " ")

          End If
      
         
          m.SaveAs "Y:\Patientendaten\" & strname & " " & "Datum" & "_" & Day(Date) & "_" _
            & Month(Date) & "_" & Year(Date) & "_" & "Uhrzeit" & "_" & Hour(Time) & "_" _
            & Minute(Time) & ".msg", olMSG
      
          myItem.Close olSave
          myItem.UnRead = True

      End If
    Next
   
    Set ns = Nothing
    Set itm = Nothing
    Set m = Nothing
 
End Sub