Link to home
Start Free TrialLog in
Avatar of ossAdmin
ossAdmin

asked on

VBScript: include sub distribution lists into one main list (to avoid size limitation).

Hello,

I've a question related to this one.
The mentionned post was related to the size limitation of distribution list in Outlook 2007 SP1 and below.

The solution proposed (and accepted) was to created sub distribution lists with limited size and include them in a "main" list.
Unfortunately nor the proposed script neither several tested variants work (running Outlook 2003).
The result is always the same: the sub-lists are well created, but the main list remains empty.

Has anyone already tried to implement this solution? How?

Many thanks in advance for your help,
OssAdmin.
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Whilst I cannot be sure of the issue with Patricks code, I had something similar in outlook which I have converted to VBS and tested in Outlook XP ... it appears ok.

I include some test lines to populate an array with data instead of line statements but as long as you pass bigdl an array with all the names and a string constant to be the DL name then it should work.

Note as presented it deletes any pre-existing DL of the same name.

Chris
For intLooper = 1 To 355
        ReDim Preserve arrAddresses(intLooper)
        arrAddresses(intLooper) = "TestAddress" & intLooper & "@domain.com"
    Next
    Set myDL = BigDL("TestDL", arrAddresses)

Function BigDL(strDLName, arrNames)
    set olkapp = createobject("outlook.application")
    killItem olkapp.Session.GetDefaultFolder(10), strDLName
    Set BigDL = olkapp.CreateItem(7)
    BigDL.DLName = strDLName
    For intBlock = 1 To UBound(arrNames) \ 100
        killItem olkApp.Session.GetDefaultFolder(10), strDLName & "_" & intBlock
        Set DL = olkApp.CreateItem(7)
        DL.DLName = strDLName & "_" & intBlock
        Set mai = olkApp.CreateItem(0)
        For intItem = 1 To 100
            If UBound(arrNames) < ((intBlock * 100) + intItem) Then Exit For
            With mai.Recipients
                .Add arrNames((intBlock * 100) + intItem)
            End With
        Next
        mai.Recipients.ResolveAll
        DL.AddMembers mai.Recipients
        DL.Save
        Set mai = olkApp.CreateItem(0)
        mai.recipients.add strDLName & "_" & intBlock
        mai.recipients.resolveall
        BigDL.AddMembers mai.recipients
    Next
    BigDL.Save
    mai.delete
    Set DL = Nothing
    Set mai = Nothing
    olkapp.quit

End Function

Sub killItem(fldr, strName)
    For itm = fldr.items.count To 1 Step -1
        With fldr.items(itm)
            If .Class = 69 Then
                If LCase(.DLName) = LCase(strName) Then .Delete
            End If
        End With
    Next
End Sub

Open in new window

Hmmm

I thought i'd check Patricks code as well ... and it works on the same XP machine so whilst you ought to try 'my' code it may be that it is no better.  It is slightly different in implementation so maybe ... maybe!

Chris
Avatar of ossAdmin
ossAdmin

ASKER

Thanks Chris!
I'll test your proposal ASAP.

It's indeed too bad that the Patrick's script works for both of you but fails on all PCs on which I've tested it :-( ...

I'll keep you informed.
ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial