Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

MS Outlook Attachments 1

Status
Not open for further replies.

Corbie

Technical User
Nov 19, 2001
21
GB
I need to automate saving outlook attachments to folders
based on their subject. (thats only the attachments, I don't meen just moving the message to another outlook folder). (ie receiving accounts download information via e-mail and then consolidating them in excel -at the moment I save each attachment manually to "c:\download" and my consolidation spreadsheet picks them all up - but at 150 returns its taking a bit too long!!!)

I'm not too bad at VBA for excel, but have never touched programming in Outlook.

Any ideas would be gratefully accepted.
 
Corbie,

I use the coding below to save all attachments from any folder I choose to a network drive, it will go through all emails in the folder and if it finds an attachment it will save the attachment to the network drive, hope it helps.

Sub Save_Attachments()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItem As MailItem
Dim objAtts As Attachments
Dim strMsg As String
Dim intAns As Integer
Dim intRes As Integer
Dim strControl
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
strControl = 0
For Each objItem In objFolder.Items
Set objAtts = objItem.Attachments
strControl = strControl + 1
If objAtts.Count > 0 Then
If intRes = vbYes Then
strMsg = "SAve attachments " & _
"from " & (objItem.Subject) _
& "?"
intAns = MsgBox(strMsg, _
vbYesNo + vbQuestion, _
"Clean Attachments")
Else
intAns = vbYes
End If
If intAns = vbYes Then
For Each ObjAtt In objAtts
strfilename = "M:\Templates\Saved Files\" & strControl & ObjAtt.FileName
ObjAtt.SaveAsFile strfilename
Next
End If
objItem.Save
End If
Next

For I = 1 To objFolder.Items.Count
Set objItem = objFolder.Items(I)

If Err = 0 Then
If objItem.UnRead Then
objItem.UnRead = False
End If
Else
Err.Clear
End If
Next I
MsgBox "No Unread Items in folder " & vbCrLf _
& " " & objFolder & ".", vbInformation

MsgBox "All attachments have been " & vbCrLf _
& "saved to H:\Drive!", vbInformation

End Sub

p.s it also marks all the messages unread, so you don't have too.

Rob.

Thanks Rob.[yoda]
 
Thanks, with a little modification to suit my situation it has worked perfectly and will save me hours and hours of boring manual saving.

Thanx again
 
is this code stored within outlook.
if so how and where is it stored?

Never ever, bloody anything, ever
 
You store this in a standard module within outlook.

Thanks Rob.[yoda]
 
Can anyone tell me how to create a module within Outlook.
do i need any extra extensions installed in the system for this to work.
Ive tried the help file for VB but im told the help file doesnt exist and i cant find any topics on modules within Outlook.

Never ever, bloody anything, ever
 
Hi

Just press alt f11 within outlook, this will bring the editor up. This just insert modules as normal

Hope this helps
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top