Link to home
Start Free TrialLog in
Avatar of jamiepryer
jamiepryerFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Vb outlook folder browser

Hi,
I've got some code that downloads all the attachments, from all emails, with an outlook folder. I'm running this from excel vb

The problem is that i have to specify the outlook folder to browser witin the code, eg.
Olinbox.item("personal").Items

If possible, i need some code that will popup a browser, so you can specify the outlook folder to look in?
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Hello jamiepryer,

Dim olApp As Object
Dim olNS As Object
Dim olSrcFolder As Object
    Set olApp = GetObject(, "outlook.application")
    If TypeName(olApp) <> "Application" Then Set olApp = CreateObject("outlook.application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olSrcFolder = olNS.PickFolder

Regards,
Chris
Avatar of jamiepryer

ASKER

hi,
thanks so much for your help. thats just what i was after.
I now have a bit of a follow up if possible?

this is what i have so far, however it keeps falling over on the "Set olItems" line
I think this might be because the pickfolder part, only shows the final name you seclect and not the whole tree?

what im trying to do is download all the attachments from a chosen folder, within outlook....

Sub test982()


Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.Folders
Dim olItems As Outlook.Items
Dim olEmail As Outlook.MailItem
Dim olHasAttach As Outlook.Attachments
Dim olAttach As Outlook.Attachment
Dim Count As Integer

Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olSrcFolder = olNS.PickFolder
Set olInbox = olNS.GetDefaultFolder(olFolderInbox).Folders
Set olItems = olInbox.Item(olSrcFolder).Items 'set you folder name within Inbox here
Set olEmail = olItems.GetFirst

Count = 0

For Each olEmail In olItems
    Set olHasAttach = olEmail.Attachments
    If olHasAttach.Count > 0 Then
        Set olAttach = olHasAttach.Item(1)
        olAttach.SaveAsFile ("O:\test\" & olAttach) 'location to save the file in.
        Count = Count + 1
    End If
Next olEmail

MsgBox "Total Attachments saved = " & Count, vbInformation, "Completed..."

End Sub
Pretty simple really:

Replace
Set olItems = olInbox.Item(olSrcFolder).Items 'set you folder name within Inbox here
with
Set olItems = olInbox.Items 'set you folder name within Inbox here

Chris
Hi, this still doesn't work, sorry.
It works find if i select just 1 folder level down. Eg.
Inbox - personal
However if i change it to a team mailbox, it wont work, or more then one folder down, eg
Inbox - personal - important
ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
A couple of comments....

Dim olEmail as Object         '(otherwise it will fall over whenever it hits a receive receipt or anything else other than a plain email.
You can just work with email objects by adding an if statement
If olEmail.class = 43 then  'class for email items

Use
 on error resume next
after your dim statements.

You are only saving the first attachment - so you want to save more than one if it exists? Replace your 'if olhasattach.count>0 ' statement with
For j = 1 to olHasattach.count        '   if count is 0 this wont run
   Set olAttach = olHasAttach.Item(j)

Next
Thanks both for your help, especially the stuff about the class as those damn read receipts were doing my head in! Ha!

Still cant get the proper outlook browser to work, so wrote my own. Any suggestions or thoughts?

.......................
Sub GetOutlookAttachments5()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.Folders
Dim olItems As Outlook.Items
Dim olEmail As Outlook.MailItem
Dim olHasAttach As Outlook.Attachments
Dim olAttach As Outlook.Attachment
Dim Count, X, J As Integer
Dim ItemCount, ItemNumber As Integer
Dim TmpString As String
Dim TmpOLinbox As Outlook.Folders

TestGetFolderName (Foldername)
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
    ItemCount = olNS.Folders.Count
    If ItemCount > 0 Then
        TmpString = "Option 0 - Root Folder (this one)" & vbCrLf
        For X = 1 To ItemCount
            TmpString = TmpString & "Option " & X & "  (" & olNS.Folders.Item(X) & ")" & vbCrLf
        Next X
    End If
    ItemNumber = InputBox("Please select an outlook mailbox to search within" & vbCrLf _
                    & "----------------------------" & vbCrLf _
                    & TmpString & vbCrLf _
                    & "----------------------------", "Input a Number")

Set TmpOLinbox = olNS.Folders.Item(ItemNumber).Folders
Set olInbox = TmpOLinbox

Do Until ItemCount = 0

    ItemCount = olInbox.Count
    If ItemCount > 0 Then
        TmpString = "Option 0 - Root Folder (this one)" & vbCrLf
        For X = 1 To ItemCount
            TmpString = TmpString & "Option " & X & "  (" & olInbox.Item(X) & ")" & vbCrLf
        Next X
           
            ItemNumber = InputBox("Please select an outlook folder to search within" & vbCrLf _
                        & "----------------------------" & vbCrLf _
                        & TmpString & vbCrLf _
                        & "----------------------------", "Input a Number")
        If ItemNumber <> 0 Then
            Set olInbox = TmpOLinbox.Item(ItemNumber).Folders
            Set TmpOLinbox = olInbox
        Else
        ItemCount = 0
        End If
    End If
Loop

Set olItems = olInbox.Parent.Items
ItemCount = olItems.Count
If ItemCount = 0 Then
    MsgBox "This folder doesnt have any emails in it!" & vbCrLf _
        & "Please try again", vbCritical, "Error..."
        Exit Sub
End If

Set olEmail = olItems.GetFirst

Count = 0
For Each olEmail In olItems
    If olEmail.Class = olM

Set olEmail = olItems.GetFirst
 
Count = 0
For Each olEmail In olItems
    If olEmail.Class = olMail Then
        Set olHasAttach = olEmail.Attachments
        For J = 1 To olHasAttach.Count
            Set olAttach = olHasAttach.Item(J)
            olAttach.SaveAsFile (Foldername & "\" & olAttach)
            Count = Count + 1
        Next J
    End If
Next olEmail
 
MsgBox "Total Attachments saved = " & Count, vbInformation, "Completed..."
 
End Sub

Open in new window

I've had problems with lots of things coding outlook, but not olNS.pickfolder. I would persevere with getting that working.
What version of Outlook are you coding for?
Try ...
Dim olInbox as Outlook.MAPIfolder    
followed by
Set olInbox = olNS.PickFolder
I don't think it will like Dim olInbox as Outlook.Folders - that could be part of the problem
Not quite sure what you are trying to do with the home made browser. Folders can have items in as well as folders in - so not sure what the itemcount is trying to do.
The pickfolder definitely works fine as does the folder selection in my snippet earlier.  Are you sure about yuour definitions, i.e. the folder needs to be mapifolder.

If you p[ost the standard code of your own with the new changes but using pickfolder then perhaps we can see where it is going wrong

Chris
Just noticed you said excel VB ... do you have the excel reference library enabled?

in the VBe tools | References | select |Microsoft Excel nnn object library

Chris
thanks