Consulting

Results 1 to 8 of 8

Thread: export folder and subfolder size to excel

  1. #1
    VBAX Mentor OTWarrior's Avatar
    Joined
    Aug 2007
    Location
    England
    Posts
    389
    Location

    export folder and subfolder size to excel

    I have been asked to find out the reason for an outlook account having such a large filesize, and was wanting to do a macro to export each subfolder name with it's size into excel, to see which is the largest, then use that for suitable archiving.

    I have searched and have yet to find anything suitable. Anyone attempted this before?
    -Once my PC stopped working, so I kicked it......Then it started working again

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Hi OTWarrior,

    I've barely touched Outlook, so no doubt a crude attempt, but maybe enough to get the thread started?

    In a Standard Module:
    Option Explicit
        
    Enum eFol
        olFolDeletedItems = 3
        olFolDrafts = 16
        olFolInbox = 6
        olFolSentMail = 5
    End Enum
        
    Sub exa_folsize()
    Dim OL          As Object '<--- Outlook.Application
    Dim olNameSpace As Object '<--- NameSpace
    Dim oDefFol     As Object '<--- MAPIFolder
    Dim olSubFol    As Object '<--- MAPIFolder
    Dim x           As Long
    Dim y           As Long
    Dim vntDef      As Variant
    Dim aryInfo     As Variant
    Dim aryOutput   As Variant
        
        With Range("A1:D1")
            .Value = Array("Folder", "Size(kb)", "Subfolder(s)", "Size(kb)")
            .Font.Bold = True
        End With
        '// To match above labels, as we initially do not know how many folders/subfolders  //
        '// we may find - we'll start an array with 4 rows and unk columns; then transpose  //
        '// later.                                                                          //
        ReDim aryInfo(1 To 4, 0 To 0)
        
        '// I believe Outlook is single instance, so CreateObject should be okay.           //
        Set OL = CreateObject("Outlook.Application")
        Set olNameSpace = OL.GetNamespace("MAPI")
        
        
        For Each vntDef In Array(olFolDeletedItems, olFolSentMail, olFolDrafts, olFolInbox)
            Set oDefFol = olNameSpace.GetDefaultFolder(vntDef)
            If oDefFol.Items.Count > 0 Then
                ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
                aryInfo(1, UBound(aryInfo, 2)) = oDefFol.Name
                aryInfo(2, UBound(aryInfo, 2)) = AddSize(oDefFol)
            End If
            If oDefFol.Folders.Count > 0 Then
                For Each olSubFol In oDefFol.Folders
                    ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
                    aryInfo(3, UBound(aryInfo, 2)) = olSubFol.Name
                    aryInfo(4, UBound(aryInfo, 2)) = AddSize(olSubFol)
                Next
            End If
        Next
        ReDim aryOutput(1 To UBound(aryInfo, 2), 1 To 4)
        
        For x = 1 To UBound(aryInfo, 2)
            For y = 1 To 4
                aryOutput(x, y) = aryInfo(y, x)
            Next
        Next
        
        Range("A2").Resize(UBound(aryInfo, 2), 4).Value = aryOutput
        Range("A1:D1").EntireColumn.AutoFit
            
    End Sub
        
    Function AddSize(Fol As Object) As Long 'Fol As MAPIFolder
    Dim oMailItem   As Object
    Dim lSize       As Long
        
        lSize = 0
        For Each oMailItem In Fol.Items
            lSize = lSize + oMailItem.Size
        Next
        '// Return in KB    //
        AddSize = lSize \ 1024
    End Function
    Hope that helps,

    Mark

  3. #3
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    Outlook version?

    In Outlook 2003, right-click on the mailbox name, go to "Properties for Mailbox ..." and click the "Folder Size" button.
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  4. #4
    VBAX Mentor OTWarrior's Avatar
    Joined
    Aug 2007
    Location
    England
    Posts
    389
    Location
    Quote Originally Posted by JP2112
    Outlook version?

    In Outlook 2003, right-click on the mailbox name, go to "Properties for Mailbox ..." and click the "Folder Size" button.
    I'm sorry, I forgot this website was called "Interface express" and not "VBA Express". My mistake....
    -Once my PC stopped working, so I kicked it......Then it started working again

  5. #5
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    Your goal is to find out the reason why a particular Outlook account has a large file size. I've suggested one method for arriving at that goal. You're free to use or ignore it. What I don't understand is why you've polluted your goal by requiring that it be solved with VBA.

    Asking a question on a help forum and then criticizing the answer when it isn't the one you wanted is only going to limit the amount of future help you receive.
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  6. #6
    VBAX Mentor OTWarrior's Avatar
    Joined
    Aug 2007
    Location
    England
    Posts
    389
    Location
    Quote Originally Posted by JP2112
    Your goal is to find out the reason why a particular Outlook account has a large file size. I've suggested one method for arriving at that goal. You're free to use or ignore it. What I don't understand is why you've polluted your goal by requiring that it be solved with VBA.

    Asking a question on a help forum and then criticizing the answer when it isn't the one you wanted is only going to limit the amount of future help you receive.
    first of all there are about 200 sub folders in this email account, so right clicking and using properties, then manually recording the number into excel will take ages.

    As for me criticizing your answer, yes I will when it is not helpful at all, and makes it appear like you are just trying to add to your post count. This is a forum for code discussion. My question was has anyone done anything like this before, not what is the easiest way to find out one individual folder size at a time.

    Consequently, posting arrogant and obvious answers to someone's thread will make people ignore your suggestions in future. I know I will.

    PS: Often programmers like to know if something can be done, just out of curiosity, as well as for practical use. Yes, spending a day finding the solution to a programming problem, when the actual task could be done in a couple of hours may appear to be a waste of time, until someone asks for similar data. Then said tool can save time.
    -Once my PC stopped working, so I kicked it......Then it started working again

  7. #7
    The code below is perfect and what I am looking for however after several attempt I am not able to add a outlook brower tool to select the inbox I would like to scan - any one can help?


    Quote Originally Posted by GTO View Post
    Hi OTWarrior,

    I've barely touched Outlook, so no doubt a crude attempt, but maybe enough to get the thread started?

    In a Standard Module:
    Option Explicit
        
    Enum eFol
        olFolDeletedItems = 3
        olFolDrafts = 16
        olFolInbox = 6
        olFolSentMail = 5
    End Enum
        
    Sub exa_folsize()
    Dim OL          As Object '<--- Outlook.Application
    Dim olNameSpace As Object '<--- NameSpace
    Dim oDefFol     As Object '<--- MAPIFolder
    Dim olSubFol    As Object '<--- MAPIFolder
    Dim x           As Long
    Dim y           As Long
    Dim vntDef      As Variant
    Dim aryInfo     As Variant
    Dim aryOutput   As Variant
        
        With Range("A1:D1")
            .Value = Array("Folder", "Size(kb)", "Subfolder(s)", "Size(kb)")
            .Font.Bold = True
        End With
        '// To match above labels, as we initially do not know how many folders/subfolders  //
        '// we may find - we'll start an array with 4 rows and unk columns; then transpose  //
        '// later.                                                                          //
        ReDim aryInfo(1 To 4, 0 To 0)
        
        '// I believe Outlook is single instance, so CreateObject should be okay.           //
        Set OL = CreateObject("Outlook.Application")
        Set olNameSpace = OL.GetNamespace("MAPI")
        
        
        For Each vntDef In Array(olFolDeletedItems, olFolSentMail, olFolDrafts, olFolInbox)
            Set oDefFol = olNameSpace.GetDefaultFolder(vntDef)
            If oDefFol.Items.Count > 0 Then
                ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
                aryInfo(1, UBound(aryInfo, 2)) = oDefFol.Name
                aryInfo(2, UBound(aryInfo, 2)) = AddSize(oDefFol)
            End If
            If oDefFol.Folders.Count > 0 Then
                For Each olSubFol In oDefFol.Folders
                    ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
                    aryInfo(3, UBound(aryInfo, 2)) = olSubFol.Name
                    aryInfo(4, UBound(aryInfo, 2)) = AddSize(olSubFol)
                Next
            End If
        Next
        ReDim aryOutput(1 To UBound(aryInfo, 2), 1 To 4)
        
        For x = 1 To UBound(aryInfo, 2)
            For y = 1 To 4
                aryOutput(x, y) = aryInfo(y, x)
            Next
        Next
        
        Range("A2").Resize(UBound(aryInfo, 2), 4).Value = aryOutput
        Range("A1:D1").EntireColumn.AutoFit
            
    End Sub
        
    Function AddSize(Fol As Object) As Long 'Fol As MAPIFolder
    Dim oMailItem   As Object
    Dim lSize       As Long
        
        lSize = 0
        For Each oMailItem In Fol.Items
            lSize = lSize + oMailItem.Size
        Next
        '// Return in KB    //
        AddSize = lSize \ 1024
    End Function
    Hope that helps,

    Mark

  8. #8
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    This is a 12 yo thread. Please start a new thread. You can link back to this thread.

    this thread is now Closed.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •