ࡱ> Root Entryi __properties_version1.00,__nameid_version1.0(-ii__substg1.0_0E04001E* g o !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWYZ[\]^_`abcdefhijklmnpqrstRoot EntryFFj __properties_version1.00,__nameid_version1.0(-ii__substg1.0_0E04001E* g o !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWYZ[\]^_`abcdefhijklmnpqrst__substg1.0_0E03001E* __substg1.0_0E02001E*__substg1.0_80000102*X__substg1.0_80010102* R__substg1.0_80020102*v__substg1.0_80030102* __substg1.0_80050102* Q__substg1.0_001A001E* __substg1.0_0037001E* __substg1.0_0E1D001E*__substg1.0_300B0102*__substg1.0_800A001E* __substg1.0_8010001E*__substg1.0_003D001E* __substg1.0_34140102*__substg1.0_00020102*Z  !"#$%&'()*+-./0123456TUVWXYNITA7n681162818-1909200210.0GٷE`O#LIPM.Note.Mailing ListBccBccDCCCCMessageMessage Mailing List Mailing List ( @ww{ppp `````wwwwp6 &(( @83w8x7pp{pwwwww{f`f`f`ffffff`ffff`fff`fwwwffwf``wwwwwwwwww( {wp p`p``p``pppp@0-i@0-iRv AQ- A7O[JU' BuildTodaysMailing ' ' This "package" can be attached to a mail form to help build a "mailing" based on a bunch of ' messages that you have in an Outlook folder. It builds it in the form: ' ' To: My Mailing List Name ' Cc: Those I want to Cc To ' Bcc: My Actual Mailing List ' Subject: Volume #, Issue # -- Saturday, 12 September 1998 '-------------------------------------------------------------------------- 'Today's topics: '1) Blah Blah ' from Joe Smoe '2).... ' '-------------------------------------------------------------------------- '1) Blah Blah ' from Joe Smoe ' 'I'm Joe Smoe. I think that... ' '............. ' '[Signature file gets inserted at the end] ' ' Messages are sorted by size (smallest to largest) and then received time. You can cause ' this to be only by received time by setting lngMyFactor to a really high factor. The mentality ' behind such procedure is that on the mailing list I created this to save time with, we have ' people who are more long-winded than others. By sorting by size, people can nibble at the ' top, saving the long ones for later (or not at all). It also means that the short ones aren't ' lost in the big ones. lngMyFactor basically helps make sure that two messages that are close ' to each other in size don't get sorted on an insignifcant number of bytes. ' ' The topics come from the message subjects and the "from" come from the received from. ' ' The format is pretty well stuck at being the above, although you can alter the "Volume," ' "Issue," and "Today's topics" labels (see global variable list below). Of course, you ' control the value of "MyTo" and "MyBcc" too. The date format will change to whatever ' Vbscript thinks it is base on your computer's settings (it is a "long" date format). ' ' Depending how you set the value of some booleans below, you can supply the values for ' 1) The volume number ' 2) The issue number ' 3) The signature file ' 4) The "To" field ' 5) The "Cc" field ' 6) The "Bcc" field ' 7) The beginning of the "Body" field ' in notes. If you are in a mail directory called "My Mailing List" we will look for notes ' with the appropriate names in a Notes folder called "My Mailing List" under the main Outlook ' Notes folder. The first line of each note is the label, the second the value. The note labeled: ' "Volume" has our volume number. Defaults to 1. ' "Issue" has our issue number. Defaults to 1. ' "Signature File" has our signature file location. Defaults to nothing. The reason I don't ' get a signature directly from a note is I want to support the standard functionality ' of an Outlook signature (as best I can). ' "To" has our To value. Defaults to nothing. ' "Cc" has our Cc value. Defaults to nothing. ' "Bcc" has our Bcc value. Defaults to nothing. ' "Body" has a default top to our body. ' ' If you look through the global varables and Item_Open Sub below, you should see how to ' configure this script for your use. Just have a button on your form whose '_click' event ' calls BuildTodaysMailing or put a call to BuildTodaysMailing in the OpenItem sub so that ' it runs whenever you open the form. You can e-mail me if you have any troubles. ' ' One global variable to especially note is lngMaxBytes. It is the maximum number of bytes ' we will put into a single message body. We will split up into another message if, by adding ' the nextbody part, we would go over this value. I have added this to deal with our ' faithful juno.com listeners :-) ' ' By the way, I recommend that you set the "To" field to a value that point right back to the ' mailing list address (so you get mail from their "reply" button), and that you use the ' Bcc field for your mailing list addresses. My belief is that it is best to keep e-mail ' addresses confidential unless a person really wants it out there. ' ' This code is covered by the GNU public license. Basically, freely received, freely give. ' ' It's my first use of vbscript, so I'm sure it has some holes or better ways it could be ' done. Feel free to e-mail me with suggestions (or to just say hi). ' ' Alan Fahrner -- alan@chelz.com -- http://www.chelz.com/ ' Created -- 12 September 1998 ' Updated last -- 14 September 1998 ' (Consolidated note reading functions into 1, added "To" and "Body" note support, ' and added ability to split mailings into multiple parts based on a lngMaxBytes variable. ' Also got rid of non-required error messages and did some clean up.) ' First, all our "Global" variables. Initialized in "Sub Item Open" ' Make sure we don't have any surprises with variables Option Explicit Dim strMessageSeparator ' We put this between section and messages Dim lngMyFactor ' This is the number of bytes for which if two messages ' are within we consider them the same size. Dim strTopicsLabel ' Label above our topic Dim strTopicsLabelOnlyOne ' Label above our topic if we only have one message Dim strVolumeLabel ' The "Volume" part of "Volume 1, Issue 1" Dim strIssueLabel ' The "Issue" part of "Volume 1, Issue 1" Dim strPartLabel ' The "Part" part of "Volume 1, Issue 1... -- Part 1" Dim lngMaxBytes ' This is the largest sized body we will put into one message. ' We will split into "Part I," "Part II," etc. Should help ' protect our juno.com friends :-). Dim strBodyTooBig ' Since we split between whole bodies, this will help us see if we somehow ' have a part over or lngMaxBytes ' This happens whenever the form opens. Just use it to initialize some variables. Sub Item_Open strMessageSeparator = String(70,"-") & vbNewLine lngMyFactor = 200 strTopicsLabel = "Today's Topics:" strTopicsLabelOnlyOne = "Today's Topic:" ' Include the end space in the following three labels strVolumeLabel = "Volume " strIssueLabel = "Issue " strPartLabel = "Part " lngMaxBytes = 49000 ' Don't change this one strBodyTooBig = "" End Sub ' Our main function Sub BuildTodaysMailing 'Declare our variables Dim fldMyFolder ' this folder Dim itmsMyItems ' items in this folder Dim itmMyItem ' single item Dim msgMyMessage() ' We have to create a new message so that ' outlook form stuff doesn't get sent with ' the message. ' Arrays for info about our folder messages Dim arrBodySizes() ' body sizes Dim arrMessageSubjects() ' subjects Dim arrReceivedTime() ' when we got the message Dim arrMessageFrom() ' who we got the message from Dim arrSortedBodySizes() ' we sort our messages by size in this array Dim arrTopics() ' we put the topics we build in here Dim i, j, k ' counters Dim lngPresentBytes ' How many bytes are we up to? Dim intPartNumber ' What part number are we ' Initialize a couple values lngPresentBytes = 0 intPartNumber = 1 ReDim msgMyMessage(1) ' find our active folder set fldMyFolder = Application.ActiveExplorer.CurrentFolder ' Make sure we have some messages to deal If fldMyFolder.Items.Count = 0 Then MsgBox "There are no items in folder " & "'" & fldMyFolder & ".'", 0, "Empty Folder" Exit Sub End If ' Are we in a mail folder? If fldMyFolder.items(1).class <> 43 Then MsgBox "This form must be used while you are in" & vbNewLine & "a folder of mail items (and you aren't) :-)", 0, "Wrong Type of Folder" Exit Sub End If ' Get our items Set itmsMyItems = fldMyFolder.Items Set msgMyMessage(1) = Application.CreateItem(0) ' Set our non-body message fields msgMyMessage(1).To = GetNoteValue(fldMyFolder.Name,"To",0,0,0) msgMyMessage(1).Cc = GetNoteValue(fldMyFolder.Name,"Cc",0,0,0) msgMyMessage(1).Bcc = GetNoteValue(fldMyFolder.Name,"Bcc",0,0,0) msgMyMessage(1).Subject = strVolumeLabel & GetNoteValue(fldMyFolder.Name,"Volume",1,0,0) msgMyMessage(1).Subject = msgMyMessage(1).Subject & ", " & strIssueLabel & GetNoteValue(fldMyFolder.Name,"Issue",1,1,0) & " -- " & FormatDateTime(Date,vbLongDate) ' Make our arrays big enough for all our messages before getting these values... ' Used to build our topic toppers and to deal with sorting our mail items... ReDim arrBodySizes(fldMyFolder.Items.Count) ReDim arrMessageSubjects(fldMyFolder.Items.Count) ReDim arrReceivedTime(fldMyFolder.Items.Count) ReDim arrMessageFrom(fldMyFolder.Items.Count) ' Get our non-body text values For i = 1 to fldMyFolder.Items.Count Set itmMyItem = itmsMyItems(i) arrBodySizes(i) = Len(itmMyItem.Body) arrMessageSubjects(i) = itmMyItem.Subject arrReceivedTime(i) = itmMyItem.ReceivedTime arrMessageFrom(i) = itmMyItem.SenderName Next ' Sort our body sizes (smallest to largest) ' Increase array size ReDim arrSortedBodySizes(fldMyFolder.Items.Count) ' Initialize array For i = 1 to fldMyFolder.Items.Count arrSortedBodySizes(i) = 0 Next ' Get ready to sort arrSortedBodySizes(1) = 1 ' We can just insert our first one ' Sort via a basic insert sort -- I mean, how many messages can you have :-) For i = 2 to fldMyFolder.Items.Count For j = 1 to i If arrSortedBodySizes(j) = 0 Then arrSortedBodySizes(j) = i ElseIf arrBodySizes(arrSortedBodySizes(j)) > (arrBodySizes(i) + lngMyFactor) or (arrBodySizes(arrSortedBodySizes(j)) <= (arrBodySizes(i) + lngMyFactor) and arrReceivedTime(arrSortedBodySizes(j)) > arrReceivedTime(i)) Then For k = i to (j+1) step -1 arrSortedBodySizes(k) = arrSortedBodySizes(k-1) Next arrSortedBodySizes(j) = i Exit For End If Next Next ' original body from our body note (if found) msgMyMessage(1).body = GetNoteValue(fldMyFolder.Name,"Body",0,0,0) ' See where we are in our number of bytes... lngPresentBytes = Len(msgMyMessage(1).body) ' dashed line (or other strMessageSeparator you have put in) SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,strMessageSeparator ' topics label If fldMyFolder.Items.Count = 1 Then SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,strTopicsLabelOnlyOne & vbNewLine Else SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,strTopicsLabel & vbNewLine End If ' Build our topic array in the format ' 1) Fine Things ' from Joe Smoe ' Resize our array ReDim arrTopics(fldMyFolder.Items.Count) ' Build our topics For i = 1 to fldMyFolder.Items.Count arrTopics(i) = Cstr(i) & ") " & arrMessageSubjects(arrSortedBodySizes(i)) & vbNewLine arrTopics(i) = arrTopics(i) & String(Len(Cstr(i)) + 5," ") & "from " & arrMessageFrom(arrSortedBodySizes(i)) & vbNewLine ' Might as well put this in our body... SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,arrTopics(i) Next ' Want a blank line in between our topics and our first post... SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,vbNewLine ' Now build our message body from the bodies of all our folder items For i = 1 to fldMyFolder.Items.Count set itmMyItem = fldMyFolder.Items(arrSortedBodySizes(i)) SetBodyCheckMax msgMyMessage,intPartNumber,LngPresentBytes, strMessageSeparator & arrTopics(i) & vbNewLine & itmMyItem.Body & vbNewLine Next ' Finally, our signature (if blnUseSigFile is set) SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,GetNoteValue(fldMyFolder.Name,"Signature File",0,0,1) ' This actually just makes sure our end body part (signature) isn't too big SetBodyCheckMax msgMyMessage,intPartNumber,lngPresentBytes,"" ' If we have more than one message part, then we need to put "Part 1" on the subject ' of part 1. Also, let's remind our user... If intPartNumber > 1 Then msgMyMessage(1).Subject = msgMyMessage(1).Subject & " -- " & strPartLabel & "1" End If ' Display our new mail messages For i = intPartNumber to 1 Step -1 msgMyMessage(i).Display Next ' Just a wee warning if we built a body that breaks our rules If Len(strBodyTooBig) <> 0 Then MsgBox "One or more bodies are too big:" & strBodyTooBig,0,"Message(s) Too Big" End If ' close the original form without saving or sending Item.Close(1) ' This is a diag thing I turn on or off... ' MsgBox Item.GetInspector.EditorType End Sub ' This function gets a value from a folder ' strFolderName is the name of the folder where we find our note in ' strNoteSubject is the note subject we are looking for ' blnIsNumeric is a flag to tell us if what we find is supposed to be numeric ' blnIncrement is a flag that, if we have a numeric field, will cause us to increment the ' value found in the note. ' blnReadFile is a flag that means to return the text from the file name that we find in ' the note that we are looking for. ' We always return a string. If the blnIsNumeric is set, we will return a 1 if we have an ' error, otherwise we will return an empty string. Function GetNoteValue(strFolderName,strNoteSubject,blnIsNumeric,blnIncrement,blnReadFile) Dim fldMyFolder ' the folder I'm looking for Dim noteMyNote ' the note we are looking for Dim intOffSet ' used below to get the value of our not Dim fso ' for our file system object Dim fh ' for our file handle Dim lngNumericValue ' holds our numeric version of our value if we need to ' increment it... ' Let's find our folder -- catching the error if we need to On Error Resume Next ' set fldMyFolder = Application.GetNameSpace("MAPI").GetDefaultFolder(12).Folders(strFolderName) set fldMyFolder = Application.GetNameSpace("MAPI").Folders("Personal Folders").Folders("Notes").Folders(strFolderName) ' set fldMyFolder = Application.ActiveExplorer.CurrentFolder.Parent.' Folders("Next Mailing Config") If Err <> 0 Then If blnIsNumeric <> 0 Then GetNoteValue = "1" Else GetNoteValue = "" End If Err = 0 Exit Function End If ' Now, to find our note... set noteMyNote = fldMyFolder.Items.Find("[Subject] = '" & strNoteSubject & "'") if TypeName(noteMyNote) = "Nothing" Then If blnIsNumeric <> 0 Then GetNoteValue = "1" Else GetNoteValue = "" End If Exit Function End If ' Get our value from the note intOffSet = Len(noteMyNote.body) - (Len(vbNewLine) + Len(strNoteSubject)) GetNoteValue = Right(noteMyNote.body,intOffSet) If Len(GetNoteValue) = 0 or (blnIsNumeric <> 0 and Not IsNumeric(GetNoteValue)) Then If blnIsNumeric <> 0 Then GetNoteValue = "1" Else GetNoteValue = "" End If Exit Function End If ' now to increment the value if needed If blnIsNumeric <> 0 and blnIncrement <> 0 Then lngNumericValue = CLng(GetNoteValue) noteMyNote.Body = strNoteSubject & vbNewLine & Cstr(lngNumericValue + 1) noteMyNote.save ' or do we need to read a signature from a file? ElseIf blnReadFile <> 0 Then ' Need to create a file system object set fso = CreateObject("Scripting.FileSystemObject") ' Open our file... On Error Resume Next set fh = fso.OpenTextFile(GetNoteValue,1) if Err <> 0 Then Err = 0 GetNoteValue = "" Exit Function End If ' Read in all the text of our signature file GetNoteValue = fh.ReadAll fh.Close End If End Function ' Function that sets up our e-mail messages, checking to make sure our bodies don't go over the max number of bytes. ' It takes the array of messages, followed by our present body part, followed by our present number of bytes, ' and then the string we are going to add to the body... Sub SetBodyCheckMax (ByRef msgMyMessage,ByRef intPartNumber,ByRef lngPresentBytes,strTempBodyBuffer) ' We could have been forced to create a message whose body is too big... If lngPresentBytes > lngMaxBytes Then strBodyTooBig = vbNewLine + strPartLabel & Cstr(intPartNumber) & " (" & Cstr(lngPresentBytes) & " bytes)" End If If lngPresentBytes + Len(strTempBodyBuffer) > lngMaxBytes and Len(strTempBodyBuffer) <> 0 Then intPartNumber = intPartNumber + 1 ReDim Preserve msgMyMessage(intPartNumber) Set msgMyMessage(intPartNumber) = Application.CreateItem(0) msgMyMessage(intPartNumber).To = msgMyMessage(1).To msgMyMessage(intPartNumber).Cc = msgMyMessage(1).Cc msgMyMessage(intPartNumber).Bcc = msgMyMessage(1).Bcc msgMyMessage(intPartNumber).Subject = msgMyMessage(1).Subject & " -- " & strPartLabel & Cstr(intPartNumber) msgMyMessage(intPartNumber).Body = strTempBodyBuffer lngPresentBytes = Len(strTempBodyBuffer) Else msgMyMessage(intPartNumber).Body = msgMyMessage(intPartNumber).Body & strTempBodyBuffer lngPresentBytes = lngPresentBytes + Len(strTempBodyBuffer) End If End Sub ' Button Click... Sub BuildMailingButton_Click BuildTodaysMailing End Sub ࡱ>  Root Entry i@Message i ifo N !"#$%&'()*,-./01235789:;<=>?@ABCD0H. D@}ER. ¯NCh08K#F~~ؗh`%F8K$FPPe`&F$ =2ToO$>8ToButton5 ?2BCC( @<BCCButtonJ$A0Subject$CMessage_0D4BuildMailingButtonK I,TahomaR ,To...@4aaTahoma@I,TahomaR  ,BBcc...@4aaTahoma@H(I,!Tahoma@P &(Subject4aaTahoma@LicKeyCompObjaControlBinding rMessage-Read i i Microsoft Forms 2.0 FormEmbedded Object9q`F@(FTo(FF@`F@(FTo(FF@`F@(FBcc(FP@`F@(FBcc(FP@`F(F7Subject(F7F `F@(FMessage(FF@Df o + CompObj 4aControlBinding 60H. ;@}5|$ ¯NCh08K$FPPe`}PCe`8K#F~~ؗh`%F $.22FromO$02@SentX&O, 124SentLabelQ$222ToF$422CC=$68 Subject4, 728 SubjectLabel$8Message_, 924FromLabel(:20ToLabel(;20CCLabel BTahomaR $@H(None!Tahoma(Sent:3X!Tahoma_-TahomaR _-TahomaR H(E-!Tahoma(jSubject:4X!Tahomaf4(From:4X!Tahoma(To:4X!Tahoma(Cc:4X!Tahoma Microsoft Forms 2.0 FormEmbedded Object9q `F@(FBFrom(FBF@`F@(F9Sent@(F9F `F@(FTo(FF@`F@(FCC(FF@`F(F7Subject(F7F `F@(FMessage(FF@D__substg1.0_00030102*S__substg1.0_00040102*R__substg1.0_10130102*Q __substg1.0_10080102*P__substg1.0_10000102*O__substg1.0_10110102*!N __substg1.0_10120102*+%M__substg1.0_100F0102*$L__substg1.0_10010102*K__substg1.0_101E0102**J__substg1.0_100A0102* ,I__substg1.0_10020102*#H__substg1.0_10090102*G__substg1.0_10100102*F__substg1.0_10030102*E__substg1.0_10040102*"(D __substg1.0_100E0102*C__substg1.0_101A0102*.)B__substg1.0_101B0102*A__substg1.0_10050102*@__substg1.0_10060102*'-?__substg1.0_101C0102*&>__substg1.0_101D0102*=__substg1.0_100D0102*<__substg1.0_100B0102*0;__substg1.0_10070102*:__substg1.0_10140102*/9__substg1.0_10150102*8__substg1.0_100C0102*7 #& )67   0?@en       =4x0.;M.6-$9!$47&6%I+D)1Qp, 5P4B3 0# 8'T 5 RE*@ /  C(2:"A`KeywordsA @R T    BPQ`$45 9!:"0#$6%7&8'C(D)E*I+p,-./x01234 56 F F