Automating Tip Capture with Office Systems 2003 - Part 2
Automating Tip Capture with Office Systems 2003 - Part 2
All you ever wanted to know about the code
The first section in the code gives credit where credit is due. The SharePoint Tips custom form was developed as a modification from a custom form that I found on Helen Feddema’s web site. Code Fragment 1 presents the details of the code development.
'Selecting Contacts from a Multi-select List Box VB Script Code
'Works with Outlook 98 or 2000
'Written by Helen Feddema 11-14-1999
'Last modified 5-2-2001
‘Modified for SharePoint Tips by Hollis Paul 1-1-2005
Code Fragment 1 – The credit lines.
The code behind the custom form is written in VBscript. The code begins with three sections of VBScript housekeeping.
· Global Variables. The global variables appear next in the code, as they have to be defined before the first subroutine or Function call.
· Item_Open function. The Item_Open function initializes the global object names for the three controls that are used to select the processing parameters.
· Item_Close function. Oddly enough, the usual object destruction code is not in the Item_Close function, where I would expect it, but in the interstice between the Item_Open function, and Item_Close function, and probably never gets executed.
Code Fragment 2 shows the three house-keeping sections of code.
Dim nms
Dim fld
Dim itms
Dim itm
Dim myitm
Dim pg
Dim ctls
Dim ctlFolder
Dim appWord
Dim AppOutlook
Dim varContactArray()
Dim cboLetters
Dim cboCategory
Dim lstContacts
Dim strWordTemplate
Dim fso
Dim strTest
Dim fLetterCreated
Dim i
Dim Ritems
Const olContacts = 10
Const olInbox = 6
Const wdDocumentsPath = 0
Const wdUserTemplatesPath = 2
Const wdProgramPath = 9
Function Item_Open()
Set AppOutlook = Item.Application
Set itm = Item.GetInspector
Set pgs = itm.ModifiedFormPages
Set pg = pgs("Select Contacts")
Set ctls = pg.Controls
Set ctlCategory = ctls("txtCategory")
Set lstContacts = ctls("lstContacts")
Set ctlFolder = ctls("txtFolder")
ctlFolder.Value = "[Default Inbox Folder]"
End Function
Set AppOutlook = Nothing
Set itm = Nothing
Set pgs = Nothing
Set pg = Nothing
Set ctls = Nothing
Set ctlCategory = Nothing
Set lstContacts = Nothing
Set ctlFolder = Nothing
Set nms = Nothing
Set fso = Nothing
Set Ritems = Nothing
Function Item_Close()
End Function
Code Fragment 2 – The global variables and housekeeping functions
The parameters have to be selected by the form operator before the designated messages are converted to single-page web files (.mht). These are the source folder, the word template name, and the category of the source messages. It is the code behind the “Select a Folder” that does the heavy lifting in the folder selection. The click-routine initializes the Outlook name-space object, and wraps a loop around the call to the name-space object’s pick folder method that ensures that the form operator selects a folder with at least one message item in it.
Note: It is essential that this folder is selected, as the form will throw an error later because the folder object was not created for its later use.
Code Fragment 3 shows the code that comprises the “Select a Folder” click-routine.
Sub cmdSetFolder_Click()
Dim fMessageFolder
'MsgBox "We are in cmdSetFolder click subroutine"
Set nms = Application.GetNameSpace("MAPI")
fMessageFolder = False
Do While fMessageFolder = False
On Error Resume Next
Set fld = nms.PickFolder
If fld Is Nothing Then
MsgBox "Please select a folder"
Exit Sub
ElseIf fld.DefaultItemType <> 0 Then
MsgBox "Selected folder does not contain mail itemss; please select another folder"
Else
fMessageFolder = True
End If
Loop
ctlFolder.Value = fld.Name
End Sub
Code Fragment 3 – The “Select a Folder” click-routine.
The selection of the second variable, the Word document template, is entirely mechanized by the drop-down List Box control, and has no code behind the control.
The selection of the final parameter, the category of the message item, is initiated the “Select a Category” button. The button is bound to the Categories field. When you click the button, it initiates the special processing that is coded into the Outlook application to create and maintain the Master Category list, and the selection of a category from that list. The selected value is left in the text control that is also bound to the Categories field. Consequently, there is no VBScript code behind the “Select a Category” button.
The three selected parameters are used to construct a “found”-items collection set of messages to be processed. This list of items is shown in a multi-line text control, basically for the reassurance of the operator. The code that mechanizes all this is contained in the click-routine of the “Fill List” button. This click-routine has two sections. Code Fragment 4 creates the collection set of messages to be processed. Code Fragment 5 fills the list from the collection set.
The key element in Code Fragment 4 is the building of the search string (the strMatch variable). The [Categories] field name is associated in the search string with the selected category value. The [BillingInformation] is set to be not equal to the value of the AlreadyDone variable. The two clauses are ANDed by a set of parentheses and quotation characters that only the most arcane Outlook wizards can figure it out. The intent of the strMatch variable is to allow the Restrict method to find the Message items in the folder that have the selected category value in the Categories field, and the Billinginformation field does not contain the phrase "MHT File Created". This allows you to keep the processed messages in the same folder.
Sub cmdFill_List_Click()
Dim strCategory
Dim strCurrentContactName
Dim strPrevContactName
Dim intCount
Dim strRow
Dim AlreadyDone
AlreadyDone = "MHT File Created"
' Set itm = Item.GetInspector
' Set nms = Application.GetNameSpace("MAPI")
'MsgBox "Folder to process: " & ctlFolder.Value
If ctlFolder.Value = "" Or ctlFolder.Value _
= "[Default Inbox Folder]" Then
Set fld = nms.GetDefaultFolder(6)
End If
Set itms = fld.Items
strCategory = pg.Controls("txtCategory").Value
If strCategory = "" Then strCategory = "SharePoint"
strMatch = "[Categories] = " & Chr(39) & strCategory & Chr(39) & " And ( [BillingInformation] <> " & Chr(39) & AlreadyDone & Chr(39) & ")"
' MsgBox "Match string: " & strMatch
Set Ritems = itms.Restrict(strMatch)
lngCount = Ritems.Count
If lngCount = 0 Then
MsgBox "No Messages to add to listbox"
Exit Sub
Else
'MsgBox lngCount & " messages to add to listbox"
End If
' Exit Sub
Code Fragment 4- Getting the Collection Set of message items to process.
Code Fragment 5 is a straight-forward loop through the items collection set that extracts the subject line and puts them in an array that is then used to initialize the lstContacts control. The lstContacts control is a drop-down listbox masquerading as a blank multi-line text box. The deception lies in the fact that it first appears in an extended, empty state. However, setting the computed array to the list property of the control puts content into control, and it ultimately looks like a list box, check-boxes and all. The use of this control is not really necessary, but I have kept it in the form, because it provides a validity check to the operator that all the message items have been found and set-up for processing, before committing to the conversion operation.
strPrevContactName = ""
ReDim varContactArray(lngCount - 1, 3)
i = 0
For Each itm In Ritems
'Check that item is a message item and has a Non-empty subject, and skip otherwise
If itm.Class = 43 Then
If itm.Subject <> "" AND itm.BillingInformation <> "MHT File Created" Then
varContactArray(i, 1) = itm.Subject
varContactArray(i, 2) = ""
i = i + 1
End If
End If
Next
'Leaving the width blank for the 2nd column makes it just the right size to display its data
'lstContacts.ColumnWidths = "0 pt; ;0 pt"
lstContacts.Width = 350
lstContacts.List() = varContactArray
' MsgBox "All messages added to drop-down list"
End Sub
Code Fragment 5 – The display of the items prior to commit.
The last thing the form operator does is click the “Create Documents” button. The click-routine behind this button has basically two fragments: 1) setting up Word, and 2) the loop that runs through the message items collection set, passing the item and the template to the “print function” that does the actual conversion. Code Fragment 6 checks that the name of the template to be used by Word has been selected, invokes the Word Application object, gets the default address to the user templates, and then opens the template file in the file system.
Note: If the template file is not found, the forms dies because VBScript cannot gracefully handle the error. So it is important to put the desired templates in the default folder of the file system for the form operator, and to get the names right.
Sub cmdLetters_Click
Dim intRows
Dim J
Dim Imax
fLetterCreated = False
intRows = Ritems.count
'Check that a Word template has been selected
Set cboLetters = ctls("cboLetters")
strWordTemplate = cboLetters.Value
If Len(strWordTemplate) < 2 Then
MsgBox "Please select a Word template"
Exit Sub
End If
'Open Word invisibly, using current Word instance if available
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err = 429 Then
Set appWord = Item.Application.CreateObject("Word.Application")
Err = 0
End If
'Get paths from Word
strDocsPath = appWord.Options.DefaultFilePath(wdDocumentsPath ) & "\"
'MsgBox "Docs Path: " & strDocsPath
strTemplatePath = appWord.Options.DefaultFilePath(wdUserTemplatesPath ) & "\"
'MsgBox "Template Path: " & strTemplatePath
strWordTemplate = strTemplatePath & strWordTemplate
'MsgBox "Selected template: " & strWordTemplate
'Check for existence of template in template folder,
'and exit if not found
Set fso = CreateObject("Scripting.FileSystemObject")
'If file is not found, a "File not found" error is raised and the
'code stops (Outlook VBS doesn't support real error handling)
strTest = fso.GetFile(strWordTemplate)
Code Fragment 6 – Initializing the Word Application object
The second fragment of the “Create Documents” click routine is just the loop through the message collections set and passing of each item, along with the word template name, to the PrintDocs function to actually perform the conversion. This code is shown in Code Fragment 7.
Imax = Ritems.Count
For i = Imax to 1 Step -1
Set myItm = Ritems(i)
Call PrintDocs(myitm,strWordTemplate)
Next
If fLetterCreated = False Then
MsgBox "No letters created; closing Word instance"
End If
appWord.Quit
End Sub
Code Fragment 7 – The conversion control loop.
After peeling back the many housekeeping layers of this conversion process, we come to the core of the operation, only to see that it consists of a set of different housekeeping operations. These housekeeping operation are more like cloves of a shallot, than layers of an onion. The first clove of the PrintDocs function is shown in Code Fragment 8, in which the category value is used to setup the variables containing path of directory to which the created .mht file is to be saved, and the e-mail address to which the message, with the .mht file is attached, is sent. This is done in a Case statement, with values hard-coded, and reflecting what has been created in advance.
Function PrintDocs(o_item,strWordTemplate)
dim strSaveName
dim strMailAddr
dim myMailItem
dim myRecip
dim nyAttach
dim strDirpath
dim strCat
Dim MyDoc
Dim MyBIProps
Dim TitleProp
Dim SubjectProp
Dim strSubject
Dim strPos
Dim strFileName
Dim FirstChar
'MsgBox "We are in PrintDocs - VBScript"
'Check that a Category has been selected
strCat = ctlCategory.value
'MsgBox "strCat = " & strCat
Select Case strCat
Case "FrontPage"
strDirpath = "C:\3_FrontPage\"
strMailAddr = "2_PosttoFrontPageTips@OutlookByTheSound.com"
Case "SharePoint"
strDirpath = "C:\3_SharePoint\"
strMailAddr = "2_PosttoSharePointTips@OutlookByTheSound.com"
Case "Outlook"
strDirpath = "C:\3_Outlook\"
strMailAddr = "2_PosttoOutlookTips@OutlookByTheSound.com"
Case "SmallBiz"
strDirpath = "C:\3_SBS\"
strMailAddr = "2_PosttoSBSTips@OutlookByTheSound.com"
Case "WUS"
strDirpath = "C:\3_WUS\"
strMailAddr = "2_PosttoWUSTips@OutlookByTheSound.com"
End Select
Code Fragment 8 – The assignment of destinations
The next clove in the central shallot is the miraculous birth of the new document, its filling with content, and the setting of its title and subject properties. In the beginning, the Document collection is nothing. You then say, add the template to the collection. Make make it Visible, and voila!, the firmament has color. (Note: the templates differ only in the background color, which gives the end-user of the documents in the Sharepoint DocLib continuous feedback concerning what topic they are researching.) Next, it is said Let MyDoc be the active document, and the document has tangible existence. But Alas, the page is blank. Then one says “Take my content, which is void, and insert after the body of the message”. And the MyDoc has content, but no name. It has an implied name—the first line of the document, but how to get that as a string? Hard to do if you are not a Word Weenie! Aha! It was our practice is to make the first line of the message the same as the subject. Let strSubject be the message subject! Clean out any quotation marks, strip off the category flag, and stuff it into the document properties. Done at last! Done at last? (Well, no. Just with this miraculous clove of the miraculous of the shallot of Word creation.) Code Fragment 9 contains the details of this magical birth and titling of the end document.
'Open a new letter based on the selected template
appWord.Documents.Add strWordTemplate
appWord.Visible = True
Set MyDoc = appWord.ActiveDocument
MyDoc.Content.InsertAfter o_item.Body
strSubject = o_item.Subject
strSubject = Replace(strSubject, """", "")
' MsgBox "1strSubject = " & strSubject
strSubject = Right(strSubject, Len(strSubject) - 5 )
' MsgBox "2strSubject = " & strSubject
' Set Title and Topic properties to strSubject
'Write information to Word custom document properties
'Set prps = appWord.ActiveDocument.CustomDocumentProperties
Set MyBIProps = MyDoc.BuiltInDocumentProperties
Set TitleProp = MyBIProps("Title")
TitleProp.Value = strSubject
Set SubjectProp = MyBIProps("Subject")
SubjectProp.Value = strSubject
Code Fragment 9 – The birth of a document on the half-shallot.
Alas, life can be so messy. Housekeeping needs be accomplished before our document of the second can be saved. Message titles can have characters in them that are illegal in file names. If they are not cleaned out or changed to something legal, then the save document fails and you are left with the open document when you think you should be all done. Code Fragment 10 cleans up the title string, truncates it to 50 characters, adds the path string, and the .mht suffix, marks the Outlook message as processed and saves it, and saves the document to the file system -- all white-glove cleaning tasks.
Note: The VbScript editor in Outlook has only limited Intellisense, and it never, no never, ever learned to look up the value of the Word parameter that designates a file to be saved as .mht format was 9. This routine can be changed to save the document in many formats, but you have to dig far enough, and it is hidden really quite a ways down in the bowels of the Word Type Library, to find the numeric equivalent of a format specification.
strFileName = strSubject
strFileName = Replace(strFileName, ".", "")
strFileName = Replace(strFileName, ",", "")
strFileName = Replace(strFileName, "\", "")
strFileName = Replace(strFileName, " ", "_")
strFileName = Replace(strFileName, ":", "")
strFileName = Replace(strFileName, "(", "")
strFileName = Replace(strFileName, ")", "")
strFileName = Left(strFileName, 50)
strSaveName = strDirPath & strFileName & ".mht"
'MsgBox "FilePathName = " & strSaveName
o_item.Mileage = "XML File Created"
o_item.BillingInformation = "MHT File Created"
o_item.Save
fLetterCreated = True
MyDoc.SaveAs strSaveName, 9
Code Fragment 10 – Saving creation and telling about it.
The final clove of this miraculous, primeval creation of a Word document out of nothing, is the anticlimactic creation of the e-mail message that transports the Word document to its crèche, where it waits for the Valkyries of the Portal to transport it into its Valhalla—the document library of the Portal. Like the creation of the Word document, where all the heavy lifting was done by the Word Application object, all the work is done by the Outlook application object. Where there is nothing, let there be a message, let this string be its subject, let that string be its recipient, let the file we saved there be its attachment, send it. Then, of course, we have to clean-up after all this creation--close the Word document, set all the objects to nothing, and return to the production loop. Code Fragment 11 presents all this in minimalist succinctness. But one thing that we will not do, on pain of reliving all those beginning programming books and classes, is notice that no value is returned by the function return statement. No. No. We will not notice that.
'Create the message, attachment, and send it
Set myMailItem = AppOutlook.CreateItem(0)
myMailItem.Subject = strSubject
myMailItem.Body = "Message with attachment for Exchange PF and SharePoint"
Set myRecip = myMailItem.Recipients.Add(strMailAddr)
Set nyAttach = myMailItem.Attachments.Add(strSaveName)
myMailItem.Send
MyDoc.close
Set MyBIProps = Nothing
Set TitleProp = Nothing
Set SubjectProp = Nothing
Set MyDoc = Nothing
Set myRecip = Nothing
Set myMailItem = Nothing
Set nyAttach = Nothing
End Function
Code Fragment 11 – Die Gotterdammerung of a “Support Solution” message