Outlook vb to save a specific named attachment to a specific folder location

[spittingfire]

Hi All,

I'm looking for some help with creating an outlook script to do the following.

I get emails with many attachments but there is only one specific attachment that I will like to save.

For the purpose of this post the name of the attachment is ABC.xls.

This is a static file name that will never change. What I am looking for is that the code will look specifically for ABC.xls and if found save it to d:\test

Any help with this will be most appreciated.

Thanks in advance.

[gmayor]

This is fairly simple with a script associated with a rule to identify the message sender (or to process all incoming messages) . The code assumes that the target folder exists and overwrites any existing file of the same name in the target folder.


Sub SaveAttachment(olItem As MailItem)
'An Outlook macro by Graham Mayor
Dim olAttach As Attachment
Dim strFname As String
Dim j As Long
Const strSaveFldr As String = "D:\Test\" 'folder must exist

On Error GoTo lbl_Exit
If olItem.Attachments.Count > 0 Then
For j = 1 to olItem.Attachments.Count
Set olAttach = olItem.Attachments(j)
If UCase(olAttach.fileName) = "ABC.XLS" Then
strFname = olAttach.fileName
olAttach.SaveAsFile strSaveFldr & strFname
Exit For
End If
Next j
olItem.Save
End If
lbl_Exit:
Set olAttach = Nothing
Set olItem = Nothing
Exit Sub
End Sub

[spittingfire]

Thanks gmayor. This is exactly what I was looking for. Much appreciated.

[thejester]

GMayor,

Similar issue, but a little different. My code pulls attachments from incoming emails and saves them to a shared drive in Outlook 2010. This also is pulling in signature images, etc, of which I do not need. I solely need ".pdf" files to be extracted from emails and saved to the shared folder. I know I am missing a simple line of code in order to accomplish this, but after several attempts, I think I may keep finding the right "IF" statement, but I can't seem to figure out what it is or where to put it.

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "\\Invoices for Processing" & _
Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item


End Sub

Any help would be greatly appreciated. Thanks.

[gmayor]

See your other post - please do not duplicate questions.