Exchange Server

Guest

Due to space and security considerations, we need to get rid of all
attachments in our mailbox store that are more than a few days old.
However, we must store the email for several years.

We're running Exchange 2003 SBS. Is there anyway from code to yank out
the attachements (they can be deleted rather than archived) in code?

Thanks for any info...

Tom Rizzo [MSFT] · Guest

You should be able to do mailbox cleanup on the server to do this without
writing code. At least, that's what I remember :)

Tom

--
Looking for a good book on programming Exchange, Outlook, ADSI and
SharePoint? Check out http://www.microsoft.com/MSPress/books/5517.asp

<etravenio@hotmail.com> wrote in message
news:1125428690.071816.220160@o13g2000cwo.googlegroups.com...

Guest

Mailbox manager can't do this on it's own-- it will just delete the
entire message. We need to retain the message, but get rid of the
attachments.

Mad Dog · Guest

If I have understood what you want correctly I think the following VBA
does pretty much what you want. Where sFolder is the path for the
folder that contains the mail items you want to strip attachments from.

I have not tested this but it is only a small change from something I
have used myself.

If you want to add a check on date received or any other conditions
that should be pretty easy.

GetFolder is courtesy of Sue Mosher - Microsoft Outlook Programming
(Most highly recommended)

Sub StripAttachments()
Dim oFolder As MAPIFolder
Dim i As Integer
Dim j As Integer
Dim oItem As MailItem
Dim oAttach As Attachment
Const sFolder As String = "Public Folders\...."

Set oFolder = GetFolder(sFolder)
For i = 1 To oFolder.Items.Count

Set oItem = oFolder.Items(i)
If oItem.Attachments.Count > 0 Then
oItem.Display
While oItem.Attachments.Count > 0
oItem.Attachments(1).Delete
Wend
oItem.Save
oItem.Close 0
End If
Next
End Sub

Public Function GetFolder(ByVal strFolderPath As String) As
Outlook.MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
'Get the route directory
Set objFolder = objNS.Folders.Item(arrFolders(0))
'Check it exists
If Not objFolder Is Nothing Then
'Loop through the layers of the path
For i = 1 To UBound(arrFolders)
'Get subdirectories
Set colFolders = objFolder.Folders

Set objFolder = Nothing
'Get the appropriate sub directory
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
'Drop out as soon as any part of the path is not
found
Exit For
End If
Next
End If
'Return Folder or nothing if folder not found
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
Set objFolder = Nothing

End Function

	Exchange Server Forum Index -> Development	All times are GMT
Page 1 of 1