2015-12-30 48 views
0

我正在使用以下代碼來計算Outlook中每個類別(代碼在Excel中)有多少封電子郵件。但它沒有考慮到任何子文件夾。你能幫我改變pickfolder以選擇任何子文件夾嗎?Outlook VBA Pickfolder命令以包含子文件夾

Sub test() 
Dim oDict As Scripting.Dictionary 
Dim olApp As Outlook.Application 
Dim olNs As Outlook.Namespace 
Dim olFolder As Outlook.MAPIFolder 

Dim olItem As Object 
Dim arrData() As Variant 
Dim CategoryCnt As Integer 
Dim c As Long 

On Error Resume Next 

Set oDict = New Scripting.Dictionary 

Set olApp = New Outlook.Application 

Set olNs = olApp.GetNamespace("MAPI") 

Set olFolder = olNs.Session.PickFolder() 

'Set olFolder = olNS.GetDefaultFolder(olFolderInbox) 

CategoryCnt = olNs.Categories.Count 



ReDim arrData(1 To 2, 1 To CategoryCnt) 

c = 0 
For Each olItem In olFolder.Items 
    If Not oDict.Exists(olItem.Categories) Then 
     c = c + 1 
     arrData(1, c) = olItem.Categories 
     arrData(2, c) = 1 
     oDict.Add olItem.Categories, c 
    Else 
     arrData(2, oDict.Item(olItem.Categories)) = arrData(2, oDict.Item(olItem.Categories)) + 1 
    End If 
Next olItem 

ReDim Preserve arrData(1 To 2, 1 To c) 

Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData) 

MsgBox ("Done") 

End Sub 

乾杯,

回答

0
Sub Folder_Picker() 

    'Needs reference to MS Outlook Object Library 

    Dim olApp As Outlook.Application 
    Dim olNs As Outlook.Namespace 
    Dim olParentFolder As Outlook.MAPIFolder 
    Dim olFolderA As Outlook.MAPIFolder 
    Dim olFolderB As Outlook.MAPIFolder 

    Set olApp = New Outlook.Application 
    Set olNs = olApp.GetNamespace("MAPI") 
Dim Folder_name(100, 100) As String 

Dim folder_count(100, 100) As String 
    i = 1 
    j = 1 

Set olParentFolder = olNs.Session.PickFolder() 

    For Each olFolderA In olParentFolder.Folders 
     'Debug.Print olFolderA.folderPath, olFolderA.Items.Count, olFolderA.Folders.Count 

     Folder_name(i, j) = olFolderA.folderPath 
     folder_count(i, j) = olFolderA.Folders.Count 

     j = j + 1 
     For Each olFolderB In olFolderA.Folders 
      ' Debug.Print olFolderB.folderPath, olFolderB.Items.Count 

     Folder_name(i, j) = olFolderA.folderPath 
     folder_count(i, j) = olFolderA.Folders.Count 

     j = j + 1 

     Next 
     j = 1 
     i = i + 1 
    Next 

End Sub 
+0

感謝@ newjenn它看起來像你在olParentFolder後我的權利,但它不是輸出,因爲我需要它。例如,Outlook中的每個類別都是誰工作的,並輸出到Excel中,每個類別的總數。給下面類似的東西? \t 史蒂夫約翰菲爾斯圖\t 1個 –

+0

謝謝,但我仍然認爲我們是在兩個不同的軌道在這裏......我說的類別,在Excel的顏色類別,我不太明白你用folderA&folderB得到什麼? –

0

的PickFolder對話無法進行定製以支持檢查樹形列表項目(Redemption有這個功能雖然)。

另外,如果你要處理來自任何給定的文件夾中所有子文件夾,你必須這樣做遞歸以確保您得到孩子的孩子一路下跌的文件夾級別,像這樣:

Sub ProcessFolderCaller() 
    Dim objInbox As Folder 

    Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
    ProcessFolder objInbox 
End Sub 

Sub ProcessFolder(objFolder As Folder) 
    Dim intX As Integer 
    Dim objSubFolders As Folders 

    Debug.Print "Processing folder '" & objFolder.Name & "'..." 

    Set objSubFolders = objFolder.Folders 

    For intX = 1 To objSubFolders.Count 
     Dim objSubjFolderA As Folder 
     Set objSubjFolderA = objSubFolders.Item(intX) 
     ProcessFolder objSubjFolderA 
    Next 
End Sub 
相關問題