Improve company productivity with a Business Account.Sign Up

x
?
Solved

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

Posted on 2011-02-25
4
Medium Priority
?
417 Views
Last Modified: 2012-05-11
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.
0
Comment
Question by:ossAdmin
  • 3
4 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34978524
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

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34978559
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
0
 

Author Comment

by:ossAdmin
ID: 34978715
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.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 34980285
It looks as though I used an old version when I converted it ... I found the one I supplied has a bug and another variant that retains the first block, (the supplied one misses some of the data) - I did sanity check it but failed to recognise the abscence of the first 100 datums.

I have not been able to test the below as VBS but the reqork required is fairly trivial so I believe this one will work correctly ... whether or not it displays the  primary DL correctly is of course another matter!

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 = 0 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
                With mai.Recipients
                    .Add arrNames((intBlock * 100) + intItem)
                End With
            end if
        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

0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

If there is anything erroneous with Exchange Database, it causes a significant effect on email communication till the user remounts the database. Further, database crash directly affects Outlook users due to which they are unable to access their ema…
In an Exchange Crossforest migration, the distribution groups can be a very complex operation that would cause loss of time, lots of issues and continued headaches if not solved in a timely manner. I had to do a similar project so I created a sc…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…
Watch the video to know how one can repair corrupt Exchange OST file effortlessly and convert OST emails to MS Outlook PST file format by using Kernel for OST to PST converter tool. It can convert OST to MSG, MBOX, EML to access them. It can migrate…

606 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question