VBA 2007 - Help with accessing a folder that's not mine.

[BeZnO]

Hello everyone,

I'm struggling to get this right. I'm making macro that safes all PDF-files in a certain outlook folder. No problems so far and it worked perfectly.
Everyone who used it didn't find a problem. Now, the way how to emails are coming in is different, first everyone got his own, now it all goes to one emailaddress.

This I can not change. So, I need to change the folder the macro is getting the emails from. I've found on the internet a code to find a folder using the folderspath.
This works for my own email, but not for the one I need.

The code:

Function found on the internet.

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder Dim TestFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer


On Error GoTo GetFolder_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
If Not TestFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = TestFolder.Folders
Set TestFolder = SubFolders.item(FoldersArray(i))
If TestFolder Is Nothing Then
Set GetFolder = Nothing
End If
Next
End If
'Return the TestFolder
Set GetFolder = TestFolder
Exit Function


GetFolder_Error:
Set GetFolder = Nothing
Exit Function
End Function

The way I call it in my code:

Set Inbox = GetFolder("\\Postvak - Berno van Dijk\Postvak IN") 'my own email address.
This works perfectly.

But I need this:

Set Inbox = GetFolder("\\Postvak - Invent - Energielabeling\Afmeldnummers\") 'email where all the mails are getting in.
Nothing is found.

I've asked the admin to run this code too, does not work either.

So, how can I get access too that outlook folder?

Thanks

[skatonni]

Try these.


Option Explicit

' Shared folder in the profile
Sub ReferenceNonDefaultFolder()

Dim objNS As Namespace
Dim objFolder As Folder

Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("Postvak - Invent - Energielabeling")
Set objFolder = objFolder.Folders("Afmeldnummers")

objFolder.Display

ExitRoutine:
Set objFolder = Nothing
Set objNS = Nothing

End Sub



' Shared folder not in the profile

Sub ResolveName()

' https://msdn.microsoft.com/en-us/library/office/ff869575%28v=office.15%29.aspx

Dim myNamespace As NameSpace
Dim myRecipient As Recipient
Dim CalendarFolder As Folder

Set myNamespace = GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("address of shared mailbox")

myRecipient.Resolve
If myRecipient.Resolved Then
ShowFolder myNamespace, myRecipient
End If

End Sub

Sub ShowFolder(myNamespace, myRecipient)
' First reference a default folder of the shared account then
' point to the parent (of the default folder) then
' point to Afmeldnummers which appears to be at the same level as the Inbox.

Dim myFolder As Folder

Set myFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set myFolder = myFolder.Parent
Set myFolder = myFolder.Folders("Afmeldnummers")

myFolder.Display

End Sub

[BeZnO]

Used the 2nd one. Works perfectly thanks!