PDA

View Full Version : Saving Email Attachements



Little John
12-21-2011, 06:55 AM
Hi I hope you can help, I have no experience of VBA at all. But i believe that it can be used to solve my query....

I am trying to transfer emails form an old groupwise accout to outlook and I can set up a rule that they can all be fowarded. However when they arrive in my Outlook inbox the original mail is an attachment. these can be individually dragged into inbox folders but that is a pain in the backside!!!

could anyone please help me set up a rule to run a script so that when an email arrives from "xxxxxx@yyyyy.com" then the attachment is saved in the outlook folder "inbox/zzzzzz"

Thank you in anticipation.

Slash
12-21-2011, 10:03 PM
Hope the below script help....it works for me. Only thing in your case you are asking to move to "outlook folder inbox/zzzzzz" but in my case its moving to "C:\Attachments\" You also need to create a folder "Temp" in the Outlook with setup rule for the e-mail to move in this folder Or you can change the "Temp" folder to "Inbox". I am not sure can the attachments only be saved in the Oulook folder without opening a new e-mail

Sub GetAttachments()

Dim ns As NameSpace
Dim Temp As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim myNewFolder As MAPIFolder
Set ns = GetNamespace("MAPI")
Set Temp = ns.GetDefaultFolder(olFolderInbox)
Set myNewFolder = Temp.Folders("Temp")

i = 0
' Check Inbox for messages and exit of none found
If myNewFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Temp.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In myNewFolder.Items
' Save any attachments found
For Each Atmt In Item.Attachments
' This path must exist! Change folder name as necessary.
FileName = "C:\Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1


Next Atmt
Next Item


' Clear memory
Application_Startup_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

End Sub