Loop mails i flere mappe i Outlook 2013 via VBA

Hvor vil du have VBA-koden anbragt?

Jeg kan godt finde ud af at lave et loop på en tabel, men kan ikke finde ud af at se ned i en specifik mappe.

Noget i denne retning:

Public Function Processmails()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim oAttachments As Outlook.Attachments
Dim oAttachment As Outlook.Attachment
Dim iMsgCount As Integer

Dim oMessage As Outlook.MailItem

Dim iCtr As Long, iAttachCnt As Long

Dim sFileNames As String
Dim aFileNames() As String


'get reference to inbox
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.PickFolder.FolderPath("MinMailMappeIOutlook")


For Each oMessage In oFldr.Items
   
   
    Set oAttachment = Nothing
    Set oAttachments = Nothing
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
   
End Function

Er det at finde evt. undermapper i en mappe - der er et problem - eller?

Nej, problemet er at jeg har en Mappe der fx hedder "Group IT", men min kode fejler her, hver gang:

Set oFldr = oNs.PickFolder.FolderPath("Group IT")

Ok - er VBA koden i Access eller?

Jeps i Access

Hvis afkorter til dette - så kan du vælge din mappe/under mappe uden fejl (har "kun" afprøvet koden i Excel):

Set oFldr = oNs.PickFolder

Så vireker det, men så åbnes en dialogboks hvor jeg fysisk skal vælge mappen :-(

Den skal vælge mappen ud fra en String

Ja pt men jeg skal finde ud af det ønskede :-)
Den mappe du ønsker via strengen kan den ligge på alle niveauer? Og er der en hovedmappen evt indbakken eller ?

Det er både mapper i roden og undermapper. Jeg har styr på indbakken, der har de trods alt gjort det nemt

Tror måske jeg har fundet svaret her:
http://stackoverflow.com/questions/22537231/getting-reference-to-outlook-mailbox-root-in-a-macro

Men skal lige teste det i aften

Ok - vi får se..

Kan stadigvæk ikke få det til at virke :-(

Denne her del, virker dog, men det er kun inbox:

Public Function Processmails()
On Error GoTo err
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.Folder
Dim of As Object
Dim oAttachments As Outlook.Attachments
Dim oAttachment As Outlook.Attachment
Dim iMsgCount As Integer
Dim oMessage As Outlook.MailItem
Dim iCtr As Long, iAttachCnt As Long

Const olFolderInbox = 6
'get reference to inbox
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set of = oNs.GetDefaultFolder(olFolderInbox)

For Each oMessage In of.Items
    Debug.Print oMessage.ConversationID & " " & oMessage.EntryID
Next
Exit Function
err:
If err.Number = 13 Then Resume Next
Debug.Print err.Description
Resume Next
End Function

Denne her kode virker også hvis jeg flytter min mappe ind under inbox:

Set of = oNs.GetDefaultFolder(olFolderInbox).Folders("GPD")

Men jeg vil også gerne se i dem der ikke er lagt ned under inbox

Løsning :-) :-) :-)

Public Function Processmails()
On Error GoTo err
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.Folder
Dim of As Object
Dim oAttachments As Outlook.Attachments
Dim oAttachment As Outlook.Attachment
Dim iMsgCount As Integer
Dim oMessage As Outlook.MailItem
Dim iCtr As Long, iAttachCnt As Long

Const olFolderInbox = 6
'get reference to inbox
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set of = oNs.GetDefaultFolder(olFolderInbox).Parent.Folders("GPD")

For Each oMessage In of.Items
    Debug.Print oMessage.ConversationID & " " & oMessage.EntryID
Next
Exit Function
err:
If err.Number = 13 Then Resume Next
Debug.Print err.Description
Resume Next
End Function