Sent Items Folder für zusätzliche Mailbox festlegen

[sammy2ooo 10]

Hallo

 

Wir haben Sammelmailboxen auf einem Exchange 2003 Server liegen, welche von verschiedenen Leuten gemeinsam genutzt werden. Werden Mails im Namen der Sammelmailbox versendet, landen die gesendeten Mails nicht im "Sent Items" Order der Sammelmailbox sondern im "Sent Items" Ordner des jeweiligen Benutzers! Leider habe ich keine Möglichkeit gefunden wie man das im Outlook 2007 steuern kann. Kann das evtl. mit einer globalen Regel am Server selber definiert werden?

 

Kennt jemand das Problem oder vielmehr eine Lösung dazu?

–

Folgendes habe ich auf After Giving Send as rights to a mailbox, sent items are placed in wrong folder. : Microsoft, Outlook, 2007 gefunden.

 

Ganz praktisch aber leider nicht global für alle am Server konfigurierbar...

 

This should do it. I say "should" because I don't have send as rights on any mailboxes and therefore couldn't test the code. It's the same basic code that I use for other purposes, so I know it's sound, just not sure about the send as portion. To use this

 

1. Start Outlook

2. Click Tools->Macro->Visual Basic Editor

3. If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession

4. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window

5. Edit the code as needed. I included comment lines wherever something needs to or can change

6. Click the diskette icon on the toolbar to save the changes

7. Close the VB Editor

8. Click Tools > Trust Center

9. Click Macro Security

10. Set Macro Security to "Warnings for all macros"

11. Click OK

12. Close Outlook

13. Start Outlook. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run. Say yes.

 

 

Private WithEvents olkSentItems As Outlook.Items

Private Sub Application_Startup()
   Set olkSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub Application_Quit()
   Set olkSentItems = Nothing
End Sub

Private Sub olkSentItems_ItemAdd(ByVal Item As Object)
   Dim olkFolder As Outlook.Folder
   'Change the name on the following line as needed.  It will have to match the name in the message exactly.
   If Item.SentOnBehalfOfName = "Doe, John" Then
       'Change the folder path on the following line to that of the folder you want the item moved to
       Set olkFolder = OpenOutlookFolder("Mailbox - Doe, John\Sent Items")
       Item.Move olkFolder
   End If
   Set olkFolder = Nothing
End Sub

Function IsNothing(obj)
 If TypeName(obj) = "Nothing" Then
   IsNothing = True
 Else
   IsNothing = False
 End If
End Function

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
   Dim arrFolders As Variant, _
       varFolder As Variant, _
       olkFolder As Outlook.MAPIFolder
   On Error GoTo ehOpenOutlookFolder
   If strFolderPath = "" Then
       Set OpenOutlookFolder = Nothing
   Else
       If Left(strFolderPath, 1) = "\" Then
           strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
       End If
       arrFolders = Split(strFolderPath, "\")
       For Each varFolder In arrFolders
           If IsNothing(olkFolder) Then
               Set olkFolder = Session.Folders(varFolder)
           Else
               Set olkFolder = olkFolder.Folders(varFolder)
           End If
       Next
       Set OpenOutlookFolder = olkFolder
   End If
   On Error GoTo 0
   Exit Function
ehOpenOutlookFolder:
   Set OpenOutlookFolder = Nothing
   On Error GoTo 0
End Function

[GuentherH 61]

Hallo.

 

Leider habe ich keine Möglichkeit gefunden wie man das im Outlook 2007 steuern kann

 

Wirst du auch nicht finden, weil es das in keiner Outlook Version gibt.

Du kannst aber ein 3rd Party Tool dafür einsetzen - eMail senden von öffentlichen Adressen - MASK - Lucatec® GmbH, Bremen, Germany

 

LG Günther

[sammy2ooo 10]

Hab das ganze noch um die "Deleted Items" erweitert. Hier der Code bei Interesse... allgemein findet man die ganzen Properties unter: http://msdn.microsoft.com/en-us/library/aa271708(office.11).aspx

 

Private WithEvents olkSentItems As Outlook.Items
Private WithEvents olkDeletedItems As Outlook.Items

Private Sub Application_Startup()
   Set olkSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
   Set olkDeletedItems = Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub

Private Sub Application_Quit()
   Set olkSentItems = Nothing
   Set olkDeletedItems = Nothing
End Sub

Private Sub olkSentItems_ItemAdd(ByVal Item As Object)
   Dim olkFolder As Outlook.Folder
   'Change the name on the following line as needed.  It will have to match the name in the message exactly.
   If Item.SentOnBehalfOfName = "IT-Service" Then
       'Change the folder path on the following line to that of the folder you want the item moved to
       Set olkFolder = OpenOutlookFolder("Postfach - IT-Service\Sent Items")
       Item.Move olkFolder
   End If

   Set olkFolder = Nothing
End Sub

Private Sub olkDeletedItems_ItemAdd(ByVal Item As Object)
   Dim olkFolder As Outlook.Folder

   If InStr(1, "IT-Service", Item.To, vbTextCompare) Or InStr(1, "IT-Service", Item.CC, vbTextCompare) Or InStr(1, "IT-Service", Item.BCC, vbTextCompare) Then
       Set olkFolder = OpenOutlookFolder("Postfach - IT-Service\Deleted Items")
       Item.Move olkFolder
   End If

   Set olkFolder = Nothing
End Sub

Public Function IsInArray(FindValue As Variant, arrSearch As Variant) As Boolean
   On Error GoTo LocalError
   If Not IsArray(arrSearch) Then Exit Function
   If Not IsNumeric(FindValue) Then FindValue = UCase(FindValue)
   IsInArray = InStr(1, vbNullChar & Join(arrSearch, vbNullChar) & vbNullChar, _
   vbNullChar & FindValue & vbNullChar) > 0
Exit Function
LocalError:
   'Justin (just in case)
End Function

Function IsNothing(obj)
 If TypeName(obj) = "Nothing" Then
   IsNothing = True
 Else
   IsNothing = False
 End If
End Function

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
   Dim arrFolders As Variant, _
       varFolder As Variant, _
       olkFolder As Outlook.MAPIFolder
   On Error GoTo ehOpenOutlookFolder
   If strFolderPath = "" Then
       Set OpenOutlookFolder = Nothing
   Else
       If Left(strFolderPath, 1) = "\" Then
           strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
       End If
       arrFolders = Split(strFolderPath, "\")
       For Each varFolder In arrFolders
           If IsNothing(olkFolder) Then
               Set olkFolder = Session.Folders(varFolder)
           Else
               Set olkFolder = olkFolder.Folders(varFolder)
           End If
       Next
       Set OpenOutlookFolder = olkFolder
   End If
   On Error GoTo 0
   Exit Function
ehOpenOutlookFolder:
   Set OpenOutlookFolder = Nothing
   On Error GoTo 0
End Function

[sammy2ooo 10]

Nochmal ne Korrektur in olkDeletedItems_ItemAdd... jetzt sollte es rocken :cool:

 

Private WithEvents olkSentItems As Outlook.Items
Private WithEvents olkDeletedItems As Outlook.Items

Private Sub Application_Startup()
   Set olkSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
   Set olkDeletedItems = Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub

Private Sub Application_Quit()
   Set olkSentItems = Nothing
   Set olkDeletedItems = Nothing
End Sub

Private Sub olkSentItems_ItemAdd(ByVal Item As Object)
   Dim olkFolder As Outlook.Folder
   'Change the name on the following line as needed.  It will have to match the name in the message exactly.
   If Item.SentOnBehalfOfName = "IT-Service" Then
       'Change the folder path on the following line to that of the folder you want the item moved to
       Set olkFolder = OpenOutlookFolder("Postfach - IT-Service\Sent Items")
       Item.Move olkFolder
   End If

   Set olkFolder = Nothing
End Sub

Private Sub olkDeletedItems_ItemAdd(ByVal Item As Object)
   Dim olkFolder As Outlook.Folder

   If Item.ReceivedByName = "IT-Service" Then
       Set olkFolder = OpenOutlookFolder("Postfach - IT-Service\Deleted Items")
       Item.Move olkFolder
   End If

   Set olkFolder = Nothing
End Sub

Function IsNothing(obj)
 If TypeName(obj) = "Nothing" Then
   IsNothing = True
 Else
   IsNothing = False
 End If
End Function

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
   Dim arrFolders As Variant, _
       varFolder As Variant, _
       olkFolder As Outlook.MAPIFolder
   On Error GoTo ehOpenOutlookFolder
   If strFolderPath = "" Then
       Set OpenOutlookFolder = Nothing
   Else
       If Left(strFolderPath, 1) = "\" Then
           strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
       End If
       arrFolders = Split(strFolderPath, "\")
       For Each varFolder In arrFolders
           If IsNothing(olkFolder) Then
               Set olkFolder = Session.Folders(varFolder)
           Else
               Set olkFolder = olkFolder.Folders(varFolder)
           End If
       Next
       Set OpenOutlookFolder = olkFolder
   End If
   On Error GoTo 0
   Exit Function
ehOpenOutlookFolder:
   Set OpenOutlookFolder = Nothing
   On Error GoTo 0
End Function