Visual Basic Maco in Outlook 2010 limited to 200 lines

I have the VB code shown below as an Outlook 2010 macro. It is intended to extract color category information from the mail folders. It outputs results to the Immediate Windows in the following format:
Message-ID: <FC177A271ECF104D8FECF73F8795FE8B2218138162@MAIL.hprs.local>~Red Category

Open in new window

I ran this a while ago for another user and it found 200 emails with categories. When I used this data to import to another mail client, she thought some were missing, but no big deal. I just ran this maco again for another user and ... 200 categorized emails found! Coincidence? I think not. And, I'm sure this current user has well over 200 categories set. So, I'm thinking there must be some kind of output limit on the Immediate Windows, or some such thing.

Is there a way to remove this limitation?
Public Sub ListOutlookFolders() 
     
    Dim olApp As Outlook.Application 
    Dim olNamespace As Outlook.Namespace 
    Dim olFolder As Outlook.MAPIFolder 
     
    Set olApp = New Outlook.Application 
    Set olNamespace = olApp.GetNamespace("MAPI") 
     
    For Each olFolder In olNamespace.Folders 
        Debug.Print olFolder.Name; ":", olFolder.Description 
        ListFolders olFolder, 1 
    Next 
     
    Set olFolder = Nothing 
    Set olNamespace = Nothing 
    Set olApp = Nothing 
     
End Sub 

Sub ListFolders(myFolder As Outlook.MAPIFolder, Level As Integer) 
    Dim olFolder As Outlook.MAPIFolder 
'  go through each email
    scanFolder myFolder

'  Now we'll check for subfolders
    For Each olFolder In myFolder.Folders 
'        Debug.Print ":"; String(Level * 2, "-"); olFolder.Name 

'        go through each email
        scanFolder olFolder

        If olFolder.Folders.Count > 0 Then 
            ListFolders olFolder, Level + 1 
        End If 
    Next 
End Sub 


Sub scanFolder(sFolder As Outlook.MAPIFolder)
Dim src As Folder
Dim oItem As Object
Dim propertyAccessor As Outlook.propertyAccessor
Set src = sFolder

Dim strHeader As String

For Each oItem In src.Items
    If TypeOf oItem Is Outlook.MailItem And oItem.Categories <> "" Then
'        Debug.Print "Cat: " + oItem.Categories
        Set propertyAccessor = oItem.propertyAccessor
        header = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D001E")
        Dim headerLines() As String
        headerLines() = Split(header, vbCrLf)

        Dim thisHeader As Variant

        For Each thisHeader In headerLines
            If InStr(thisHeader, "Message-ID:") > 0 Then
               Debug.Print thisHeader + "~" + oItem.Categories
               Exit For
           End If
        Next
    End If
Next
End Sub

Open in new window

LVL 1
MarkAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

AlanConsultantCommented:
Hi,

Rather than outputting to the immediate window, why not output to a draft mail item (I would create it to be 'to' myself just in case I accidentally hit send).

That way, you should get everything, and you can then copy / paste from the draft email item to wherever you are pasting the contents of the immediate window.

Alan.
MarkAuthor Commented:
If you can give me an example of how to do that, I'll try it. I'm no Outlook/VB expert
AlanConsultantCommented:
The easiest option would seem to be to create an empty string at the start, say:

strOutput = ""

Open in new window


Then each time you are sending output to the immediate window (debug.print statements), instead, send it to the strOutput, so for example, this:

Debug.Print ":"; String(Level * 2, "-"); olFolder.Name 

Open in new window


becomes:

strOutput = strOutput & ":"; String(Level * 2, "-"); olFolder.Name 

Open in new window



That will 'accumulate' all the items that were going to the immediate windows into that variable (strOutput), and then at the end, send it wherever you like, so perhaps to a draft email at the very end:

Set olMsg = Application.CreateItem(olMailItem)
        With olMsg
            .BodyFormat = olFormatPlain
            .Body = strOutput
            .Display
        End With

Open in new window


which will then display the draft email, and you can do whatever you like with it, same as you would have from the immediate window.


Hope that helps,

Alan.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

AlanConsultantCommented:
Hi,

Sorry - I thought from your original post that the code was yours.

I am not at a machine with Outlook right now, so I cannot test this, but perhaps try something like the following.

Since it is untested, please take care not to run it anywhere that you could lose anything you care about - only run it on a test machine with test data:

Public Sub ListOutlookFolders() 

    Dim strOutput as String
     
    Dim olApp As Outlook.Application 
    Dim olNamespace As Outlook.Namespace 
    Dim olFolder As Outlook.MAPIFolder 
     
    Set olApp = New Outlook.Application 
    Set olNamespace = olApp.GetNamespace("MAPI") 

    strOutput = ""
     
    For Each olFolder In olNamespace.Folders 
        strOutput = strOutput & olFolder.Name; ":", olFolder.Description
	strOutput = strOutput & VBcrlf
        ListFolders olFolder, 1 , strOutput
    Next 
     
    Set olMsg = Application.CreateItem(olMailItem)
        With olMsg
            .BodyFormat = olFormatPlain
            .Body = strOutput
            .Display
        End With


    Set olFolder = Nothing 
    Set olNamespace = Nothing 
    Set olApp = Nothing 
    Set olMsg = Nothing
     
End Sub 

Sub ListFolders(myFolder As Outlook.MAPIFolder, Level As Integer, strOutput as String) 
    Dim olFolder As Outlook.MAPIFolder 
'  go through each email
    scanFolder myFolder

'  Now we'll check for subfolders
    For Each olFolder In myFolder.Folders 
'        Debug.Print ":"; String(Level * 2, "-"); olFolder.Name 

'        go through each email
        scanFolder olFolder, strOutput

        If olFolder.Folders.Count > 0 Then 
            ListFolders olFolder, Level + 1 
        End If 
    Next 
End Sub 


Sub scanFolder(sFolder As Outlook.MAPIFolder, strOutput as String)
Dim src As Folder
Dim oItem As Object
Dim propertyAccessor As Outlook.propertyAccessor
Set src = sFolder

Dim strHeader As String

For Each oItem In src.Items
    If TypeOf oItem Is Outlook.MailItem And oItem.Categories <> "" Then
'        Debug.Print "Cat: " + oItem.Categories
        Set propertyAccessor = oItem.propertyAccessor
        header = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D001E")
        Dim headerLines() As String
        headerLines() = Split(header, vbCrLf)

        Dim thisHeader As Variant

        For Each thisHeader In headerLines
            If InStr(thisHeader, "Message-ID:") > 0 Then
               strOutput = strOutput & thisHeader + "~" + oItem.Categories
	       strOutput = strOutput & VBcrlf
               Exit For
           End If
        Next
    End If
Next
End Sub

Open in new window



Does that help?

Alan.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MarkAuthor Commented:
Yeah! That appeared to work! I've now got 1350 lines instead of 200. Awesome! Thanks. Here's the code that worked. It needed a couple of tweaks to run:
Public Sub ListOutlookFolders()

    Dim strOutput As String
     
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
     
    Dim objMail As Outlook.MailItem
    
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")

    strOutput = ""
     
    For Each olFolder In olNamespace.Folders
        strOutput = strOutput & olFolder.Name & ": " & olFolder.Description
    strOutput = strOutput & vbCrLf
        ListFolders olFolder, 1, strOutput
    Next
     
    Set objMail = Application.CreateItem(olMailItem)
        With objMail
            .BodyFormat = olFormatPlain
            .Body = strOutput
            .Display
        End With


    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set objMail = Nothing
     
End Sub

Sub ListFolders(myFolder As Outlook.MAPIFolder, Level As Integer, strOutput As String)
    Dim olFolder As Outlook.MAPIFolder
'  go through each email
    scanFolder myFolder, strOutput

'  Now we'll check for subfolders
    For Each olFolder In myFolder.Folders
'        Debug.Print ":"; String(Level * 2, "-"); olFolder.Name

'        go through each email
        scanFolder olFolder, strOutput

        If olFolder.Folders.Count > 0 Then
            ListFolders olFolder, Level + 1, strOutput
        End If
    Next
End Sub


Sub scanFolder(sFolder As Outlook.MAPIFolder, strOutput As String)
Dim src As Folder
Dim oItem As Object
Dim propertyAccessor As Outlook.propertyAccessor
Set src = sFolder

Dim strHeader As String

For Each oItem In src.Items
    If TypeOf oItem Is Outlook.MailItem And oItem.Categories <> "" Then
'        Debug.Print "Cat: " + oItem.Categories
        Set propertyAccessor = oItem.propertyAccessor
        header = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D001E")
        Dim headerLines() As String
        headerLines() = Split(header, vbCrLf)

        Dim thisHeader As Variant

        For Each thisHeader In headerLines
            If InStr(thisHeader, "Message-ID:") > 0 Then
               strOutput = strOutput & thisHeader + "~" + oItem.Categories
           strOutput = strOutput & vbCrLf
               Exit For
           End If
        Next
    End If
Next
End Sub

Open in new window

AlanConsultantCommented:
Great! - Glad to have helped.

Don't forget to close the question.

Thanks,

Alan.
MarkAuthor Commented:
EE loves to change things for no apparently useful reason. What's the new way to close a question? The 'Assisted' and 'Best' solution selections are now missing.
AlanConsultantCommented:
LOL - I have no idea - I haven't asked and closed a question for some time.

There was discussion of them changing to 'helpful' buttons - can you see something like that?

Alan.
MarkAuthor Commented:
Yeah, there is a "helpful" button. I clicked that. It marked the question as "helpful"! Still no close button. I'll have to post as message asking how we now close questions. Sheesh!
AlanConsultantCommented:
I guess you found it :-)

Thanks!

Alan.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.