dragnor Juniormester
17. marts 2016 - 13:26 Der er 14 kommentarer og
1 løsning

Loop mails i flere mappe i Outlook 2013 via VBA

Hej, Jeg har brug for at have en tabel med mappenavne i Outlook. Dvs. både direkte mapper og undermapper. Jeg ønsker så via VBA at loope denne tabel igennem for derved at læse alle mails i alle mapperne, og derved hente diverse informationer fra hver mail.

Jeg kan bare ikke finde ud af hvordan jeg skriver koden i VBA???

Kan nogen hjælpe mig i gang?
supertekst Ekspert
17. marts 2016 - 13:43 #1
Hvor vil du have VBA-koden anbragt?
dragnor Juniormester
17. marts 2016 - 13:48 #2
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
supertekst Ekspert
17. marts 2016 - 13:57 #3
Er det at finde evt. undermapper i en mappe - der er et problem - eller?
dragnor Juniormester
17. marts 2016 - 14:04 #4
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")
supertekst Ekspert
17. marts 2016 - 14:27 #5
Ok - er VBA koden i Access eller?
dragnor Juniormester
17. marts 2016 - 14:55 #6
Jeps i Access
supertekst Ekspert
17. marts 2016 - 15:03 #7
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
dragnor Juniormester
17. marts 2016 - 15:11 #8
Så vireker det, men så åbnes en dialogboks hvor jeg fysisk skal vælge mappen :-(

Den skal vælge mappen ud fra en String
supertekst Ekspert
17. marts 2016 - 16:25 #9
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 ?
dragnor Juniormester
17. marts 2016 - 16:49 #10
Det er både mapper i roden og undermapper. Jeg har styr på indbakken, der har de trods alt gjort det nemt
dragnor Juniormester
17. marts 2016 - 17:13 #11
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
supertekst Ekspert
17. marts 2016 - 18:24 #12
Ok - vi får se..
dragnor Juniormester
17. marts 2016 - 19:19 #13
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
dragnor Juniormester
17. marts 2016 - 19:21 #14
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
dragnor Juniormester
17. marts 2016 - 19:31 #15
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
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Premium
Test: Kæmpestort gaming-headset er perfekt til dine lange Teams-møder - men har også nogle besværligheder
Længe før vi andre blev slået hjem til hjemmekontorets endeløse webmøder har gamerne gennemskuet behovet for komfortabelt grej. Så vi tog danske EPOS top gamingheadset med på arbejde. Læs testen her.
Computerworld
Biden sender skjult besked til kode-folket: "Hvis du læser dette, har vi brug for din hjælp”
En stående invitation er blevet opdaget i kildekoden på Det Hvide Hus' hjemmeside. Men den er kun til de eksperter, der selv kan finde den.
CIO
Podcast: Hos Viking Life-Saving Equipment er it gået fra at være backend til at være noget, som kunderne spørger aktivt efter
Podcast, The Digital Edge: Viking leverer en stadig større del af deres produkt som en tjeneste. Som en del af tjenesten tager Viking ansvar for sikkerheden ved at levere, dokumentere og vedligeholde det nødvendige sikkerhedsudstyr. Hør hvordan Henrik Balslev senior digital director hos Viking har løftet den opgave.
White paper
Sådan kan du arbejde effektivt uanset tid, sted og type af enhed
Hvad nu hvis dit arbejde, din information, dine processer og teknologien bag ved, var organiseret på en måde så det passede til din organisation – alt sammen guidet af en intelligent udgave af det digitale arbejdsrum? Det er visionen bag Atea og Citrix´s samarbejde med digital workspace – en smartere og mere effektiv måde at arbejde på. I dette whitetpaper kan du derfor læse om, hvordan du kan skabe et mere effektivt og brugervenligt arbejdsrum uanset tid, sted og enhed. En løsning der på en gang er både enkel og som sætter brugeren i centrum.