jamiepryer
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").I tems
If possible, i need some code that will popup a browser, so you can specify the outlook folder to look in?
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").I
If possible, i need some code that will popup a browser, so you can specify the outlook folder to look in?
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(olFo lderInbox) .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
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(olFo
Set olItems = olInbox.Item(olSrcFolder).
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
Replace
Set olItems = olInbox.Item(olSrcFolder).
with
Set olItems = olInbox.Items 'set you folder name within Inbox here
Chris
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
ASKER
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(ItemNumb er).Folder s
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
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 _
& "-------------------------
& TmpString & vbCrLf _
& "-------------------------
Set TmpOLinbox = olNS.Folders.Item(ItemNumb
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 _
& "-------------------------
& TmpString & vbCrLf _
& "-------------------------
If ItemNumber <> 0 Then
Set olInbox = TmpOLinbox.Item(ItemNumber
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
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.
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
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
in the VBe tools | References | select |Microsoft Excel nnn object library
Chris
ASKER
thanks
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.appl
Set olNS = olApp.GetNamespace("MAPI")
Set olSrcFolder = olNS.PickFolder
Regards,
Chris