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?
jamiepryerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
jamiepryerAuthor Commented:
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
0
Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

jamiepryerAuthor Commented:
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
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Maybe to do with your definition.

Try the snippet below:

Chris
Sub test982()
 
 
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
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 olInbox = olNS.PickFolder
Set olItems = olInbox.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

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DavidT543Commented:
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
0
jamiepryerAuthor Commented:
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

0
DavidT543Commented:
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.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
Chris BottomleySoftware Quality Lead EngineerCommented:
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
0
jamiepryerAuthor Commented:
thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.