Dear Pros

I have to write a lil VBA code looking through incoming mails, if a File is attached then save it in a specific folder. Thats all no problem on my local Inbox in the subfolder "test"

Further down the code which works on my "test" folder.

The issue now, even after looking through several forums, i'm still not able to access the specific folder in the shared exchangeserver mailbox

The exchangeserver hierarchy is the following

"Mailbox - Public" // the exchangeserver would be "xxx-yyy.hh.hh"
- "Inbox"
-- Misc
--- xxx

I have to run the program on the "Misc" folder. As far as I know this is not my DefaultInbox right?

Heres the code that works for my personal inbox subfolder...

looking forward to your answers.

[VBA]Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.

On Error GoTo GetAttachments_err

' Declare variables
Dim ns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.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)
Set SubFolder = Inbox.Folders("Test")

I = 0

' Check Inbox for messages and exit of none found
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the folder " & SubFolder, _
vbInformation, "Nothing Found"
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Exit Sub
End If

' Check each message for attachments
For Each Item In SubFolder.Items
' Save any attachments found
For Each Atmt In Item.Attachments

If Atmt.FileName Like "*BlaBla*" Then
FileName = "N:\Personal\xxx\BlaBla\" & _
Format(Item.CreationTime, "yyyymmdd_") & Atmt.FileName
Atmt.SaveAsFile FileName
I = I + 1

Else
FileName = "N:\Personal\xxx\Rest\" & _
Format(Item.CreationTime, "yyyymmdd_") & Atmt.FileName
Atmt.SaveAsFile FileName
I = I + 1

End If
Next Atmt
Next Item

' Show summary message
If I > 0 Then
MsgBox "I found " & I & " attached files." _
& vbCrLf & "I have saved them into the specific 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

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

' Handle 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 Sub[/VBA]