Hej hej,

Jag har gjort ett program i Outlook VBA som skall räkna ut responsetiden för emails, loopar igenom dessa o skriver ut dem sen i Excel.

Det funkar om jag inte har några underkataloger. Men jag vill att alla mail i subkataloger skall skrivas ut också oavsett hur många subkataloger.

Typ som:

Inbox
Folder1
Folder1B
Folder1C
Folder2
...osv
Så det kan vara hur många subfoldrar som helst i Folder1...ja ni fattar.

Den kod som jag kör på nu ser ut så här.

'Start Outlook
Set myOlApp = Outlook.Application
Set myNamespace = myOlApp.GetNamespace("mapi")
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
Set myfolders = myfolder.Folders

'Loop through all email items in Outlook
'Alltså det är här som jag vill att den skall gå igenom alla underkataloger enligt ovan beskrivning.
'Jag antar att man måste ha en Foreach myfolder in myfolders
For i = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(i)


'Move data from Outlook to Excel
xlobj.Range("a" & i + 1).Value = Format(myitem.SentOn, "h:mm:ss")
xlobj.Range("b" & i + 1).Value = Format(myitem.ReceivedTime, "h:mm:ss")
xlobj.Range("c" & i + 1).Value = Format(xlobj.Range("b" & i + 1) - xlobj.Range("a" & i + 1), "h:mm:ss")

Next

Anyone?

Mvh
Nick

Hej, du får arbeta med att i din loop kolla om objektet är ett mail eller en katalog. Om det är en katalog så behöver du peka dig i i den katalogen och loopa igenom alla poster , osv. Detta brukar kallas rekursiv loop. Denna kod kanske kan hjälpa dig.

Dim oFolder, cMessages, oMailItem
 Set oFolder = fGetOLFolder("Mailbox - John Doe\Inbox\MySubFolder\My Sub SubFolder")
 Set cMessages = oFolder.Items
      For Each oMailItem In cMessages 
           sRecips = ""
                For Each oRecipient In oMailItem.Recipients
                          If Trim(sRecips) = "" Then 
                               sRecips = "To: " & oRecipient
                          Else
                               sRecips = sRecips & VbCrLf & "To: " & oRecipient
                          End If 
                Next
           sText = sRecips 
           sText = sText & VbCrLf & "From: " & oMailItem.SenderEmailAddress
           sText = sText & VbCrLf & "Subject: " & oMailItem.Subject
           sText = sText & VbCrLf & "Body: " & oMailItem.Body 
           WScript.Echo "-----------------" & VbCrLf & sText
      Next 
 
 Function fGetOLFolder(sFolderPath)
 'This function returns a folder object based on the sFolderPath variable.
 'sFolderPath is recognized as:
 'Public Folder Example - 
 '   "Public Folders\All Public Folders\MySubFolder\My Sub SubFolder"
 ' Or
 'Exchange Mailbox Example - 
 '   "Mailbox - John Doe\Inbox\MySubFolder\My Sub SubFolder"
 ' Or
 'Personal Folders Example - 
 '   "Personal Folders\Inbox\MySubFolder\My Sub SubFolder"
 Dim aFolders, oFolder, i, oNameSpace
 On Error Resume Next
 aFolders = Split(Replace(sFolderPath, "/", "\"), "\")
 Set oApplication = WScript.CreateObject ("Outlook.Application") 
 Set oNameSpace = oApplication.GetNamespace("MAPI")
 Set oFolder = oNameSpace.Folders(aFolders(0))
    For i = 1 To UBound(aFolders)
        Set oFolder = oFolder.Folders(aFolders(i))
            If Err <> 0 Then Exit Function
    Next
 Set fGetOLFolder = oFolder
 End Function

Hej Pelle,
Tack så jätte mycket för koden.
Skall testa den...ser bra ut! :-)

Från en f.d. MSFT:are.

/Nick

En fundering bara.
Kommer denna kod att loop:a igenom alla subfoldrar? Alltså, jag vet inte namnen på dem bara att de finns där?
O det kan vara 100+ subfoldrar etc.

Japp, för man använder inte namnen utan bara "gå till nästa mapp om den finns".
Prova och se, det borde fungera. Lägg bara in dina förutsättningar först man namn och liknande..

Hm säger type mismatch.

Så här har jag ändrat till:
Set oFolder = fGetOLFolder("mailbox - firstname.lastname@example.com\Inbox\Folder1\Folder1B\Folder2")
Eller skall det bara vara
Set oFolder = fGetOLFolder("\Inbox\Folder1\Folder1B\Folder2")
?

Får det fortfarande inte att funka.
Anyone?
Som sagt vet inte vad dom underliggande mapparna heter.