Save attachments from Personal Folder instead of Inbox subfolder

[xlUser]

Hi,

I have the code below that saves files from attachments in Inbox subfolder. However I need to access emails sitting in one of my personal folders. Does anyone know how to change the following reference to a subfolder in sitting in my personal folder?




Set SubFolder = Inbox.Folders("test")


The name of my personal folder is called "EAFiles.PST" and sits on my personal drive. Within this I have the folders, Generalfiles/Downloads

Downloads the folder that contains the attachments.

Hope someone can help.

Thanks,

James



Sub GetAttachments_final() 'saves excel file in specified outlook folder on specfied drive location
On Error GoTo GetAttachments_err
Dim ns As NameSpace 'gives access to outlook folders (MAPI)
Dim Inbox As MAPIFolder 'name of the folder
Dim Item As Object
Dim Atmt As Attachment 'attachment object
Dim FileName As String 'name and save path
Dim i As Integer
Dim SubFolder As MAPIFolder

'set values of the variables
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
Set SubFolder = Inbox.Folders("test") 'sub folder to search
'search folder for attachments
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Sales Reports folder." _
, vbInformation, "Nothing Found"
Exit Sub
End If

'examine each attachment in folder - only saves emails with excel attachments
If SubFolder.Items.Count > 0 Then
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "xls" Then

FileName = "F:\EA Measurement\Processes\Test Attachment Download\" & _
Format(Item.CreationTime, "dd-mm-yyyy_hhnnss_") & Atmt.FileName 'saves with file creation time as unique identifer

'FileName = "F:\EA Measurement\Processes\Test Attachment Download\" & Item.EntryID & Atmt.FileName 'includes file unique indentifier
' FileName = "F:\EA Measurement\Processes\Test Attachment Download\" & Atmt.FileName 'location to save file
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item
'summary measures of actions
If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\Email Attachments folder." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If
'clears the memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
'dealing with errors
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End If
End Sub

[JP2112]

It should be something like


Set Inbox = ns.Folders("Mailbox - Smith, John").Folders("Inbox").Folders("Generalfiles").Folders("Downloads")


Replace "Smith, John" with whatever appears in your Outlook sidebar for the topmost personal folder. I assumed "Generalfiles/Downloads" was a subfolder of the Inbox.