HOW-TO: Loop Folder, Save All Attchmts in Every Msg As

I receive >500 emails every day with heavy pdf/ppt attachments from
inter-bank counterparties. I find Outlook Rules to be partly useful. I want
to loop through all emails in an Outlook folder, and Save All attachments for
each email on my disk. Would someone suggest how I might write the macro.

Folder = "MERRILL"
Do While ( Email exists in Outlook Folder named "MERRILL" )
Open Email
Save All Attachments into D:\Mails\MERRILL\
Loop 'Next email in "MERRILL"





TIA!

Regards,
BR



--
Manager, International Private Banking, International Banking Group, ICICI
Bank
East Wing 8th floor South, ICICI Towers, Bandra Kurla Complex, Mumbai India
400051

Hi Barath,

this could do your job:

1) LoopMailFolderByFolderPath: Replace the parameter in GetFolder
through the full path to your Folder "Merrill"!

2) SaveAttachments: Replace the path in sPath through an *existing" path
you want to!


'<DieseOutlookSitzung>
Public Sub LoopMailFolderByFolderPath()
On Error GoTo ERR_HANDLER
Dim oFld As Outlook.MAPIFolder
Dim obj As Object

Set oFld = GetFolder("persönliche ordner\posteingang")
If Not oFld Is Nothing Then
For Each obj In oFld.Items
If TypeOf obj Is Outlook.MailItem Then
SaveAttachments obj
End If
Next
End If
Exit Sub
ERR_HANDLER:
MsgBox Err.Description, vbExclamation
End Sub

Public Function GetFolder(strFolderPath As String) As Outlook.MAPIFolder
'
' Author: Sue Mosher
'
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 objNS = Application.Session
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
End Function

Public Sub SaveAttachments(ByRef olMail As Outlook.MailItem)
On Error Resume Next
Dim olAtt As Outlook.Attachment
Dim sPath As String
Dim sName As String

sPath = "c:\xyz"
sPath = sPath & Format(olMail.ReceivedTime, "yyyymmdd_hhnnss_",
vbMonday, vbFirstJan1)

For Each olAtt In olMail.Attachments
sName = olAtt.FileName
ReplaceCharsForFileName sName, "_"
olAtt.SaveAsFile sPath & sName
Next
End Sub

Private Sub ReplaceCharsForFileName(ByRef sName As String, sChr As
String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
'</DieseOutlookSitzung>


--
Viele Grüße
Michael Bauer


"BHARATH RAJAMANI" <BHARATHRAJAMANI DeleteThis @discussions.microsoft.com> wrote in
message news:9B0546CE-82EA-4D88-AB2D-9EC3CE31FBC9@microsoft.com...
 >
 > I receive >500 emails every day with heavy pdf/ppt attachments from
 > inter-bank counterparties. I find Outlook Rules to be partly useful. I
want
 > to loop through all emails in an Outlook folder, and Save All
attachments for
 > each email on my disk. Would someone suggest how I might write the
macro.
 >
 > Folder = "MERRILL"
 > Do While ( Email exists in Outlook Folder named "MERRILL" )
 > Open Email
 > Save All Attachments into D:\Mails\MERRILL\
 > Loop 'Next email in "MERRILL"
 >
 >
 >
 >
 >
 > TIA!
 >
 > Regards,
 > BR
 >
 >
 >
 > --
 > Manager, International Private Banking, International Banking Group,
ICICI
 > Bank
 > East Wing 8th floor South, ICICI Towers, Bandra Kurla Complex, Mumbai
India
 > 400051<!-- ~MESSAGE_AFTER~ -->