Emptying items from a Shared mailbox's Inbox and any subfolders in it ..

[Thumper63]

Hi All!

Am an absolute newbie at this. I've spent quite a bit of time trying
to work this out ... Here's what I've managed so far ... Any help
surely appreciated here.

Option Explicit
Sub ClearOtherInbox()
Dim objFolder As Outlook.Folder

' On Error Resume Next

Set objFolder = GetOtherUserInbox("***@test.com")
Call ProcessFolder(objFolder)

End Sub

Sub ProcessFolder(StartFolder As Outlook.Folder)
' Dim objFolder As Outlook.Folder

' On Error Resume Next

' process all the subfolders of this folder
For Each StartFolder In StartFolder.Folders
Call DeleteFolderItems(StartFolder)
Next

Set StartFolder = Nothing
End Sub

Sub DeleteFolderItems(foldar As Outlook.Folder)
Dim colItems As Outlook.Items
Dim longCount As Long
Dim i As Long

Set colItems = foldar.Items
For i = longCount To 1 Step -1
colItems(i).Delete
Next
Set colItems = Nothing

End Sub

Function GetOtherUserInbox(strUserSMTP As String) As Folder
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMsg As Outlook.MailItem
Dim objRecip As Outlook.Recipient

' On Error Resume Next

Set objOL = Application
Set objNS = objOL.Session
Set objRecip = objNS.CreateRecipient(strUserSMTP)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip,
olFolderInbox)

If objFolder Is Nothing Then
MsgBox "Could not find Inbox for """ & _
strUserSMTP & """", vbExclamation, _
"User Not Found"
End If

Set GetOtherUserInbox = objFolder
Set objFolder = Nothing
Set objRecip = Nothing
Set objMsg = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Function

[Sue Mosher [MVP]]

If you use GetSharedDefaultFolder() to return the Inbox, you won't get
access to the subfolders. Instead, you can add the mailbox to your Outlook
profile (manually) and then walk the folder hierarchy, just as you would to
reach a folder in a .pst file that you might have added.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54

Post by Thumper63
Hi All!
Am an absolute newbie at this. I've spent quite a bit of time trying
to work this out ... Here's what I've managed so far ... Any help
surely appreciated here.
Option Explicit
Sub ClearOtherInbox()
Dim objFolder As Outlook.Folder
' On Error Resume Next
Call ProcessFolder(objFolder)
End Sub
Sub ProcessFolder(StartFolder As Outlook.Folder)
' Dim objFolder As Outlook.Folder
' On Error Resume Next
' process all the subfolders of this folder
For Each StartFolder In StartFolder.Folders
Call DeleteFolderItems(StartFolder)
Next
Set StartFolder = Nothing
End Sub
Sub DeleteFolderItems(foldar As Outlook.Folder)
Dim colItems As Outlook.Items
Dim longCount As Long
Dim i As Long
Set colItems = foldar.Items
For i = longCount To 1 Step -1
colItems(i).Delete
Next
Set colItems = Nothing
End Sub
Function GetOtherUserInbox(strUserSMTP As String) As Folder
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMsg As Outlook.MailItem
Dim objRecip As Outlook.Recipient
' On Error Resume Next
Set objOL = Application
Set objNS = objOL.Session
Set objRecip = objNS.CreateRecipient(strUserSMTP)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip,
olFolderInbox)
If objFolder Is Nothing Then
MsgBox "Could not find Inbox for """ & _
strUserSMTP & """", vbExclamation, _
"User Not Found"
End If
Set GetOtherUserInbox = objFolder
Set objFolder = Nothing
Set objRecip = Nothing
Set objMsg = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Function