' ' This is stored on the web as a text file so it can be viewed ' from your browser without downloading. But it should be ' saved and run as "ContactLabel.VBS" ' ' Contact Label Script. Jerome J. Slote, www.cooperstown.net ' Uses Outlook and Word Scripted Components to print a mailing label ' Requires Windows Scripting Host, which is included with Windows 98, ' or downloadable from www.microsoft.com/scripting ' ' Outlook contact must be OPEN, not merely selected. ' Replace the first three variables with values of your choice, based ' on manual selections for label printing in Word. ' LabelPrinter = "CoStar LabelWriter XL" LabelType = "30251 White" DefaultPrinter = "HP LaserJet 4P/4MP" ' mtitle="Contact Label Script for Outlook/Word" Set ol = CreateObject("Outlook.Application") Set ns = ol.GetNamespace("MAPI") Set myInspector = ol.ActiveInspector ' On Error Resume Next xx = myInspector.CurrentItem.FullName If Err.Number<>0 Then MsgBox "Outlook contact item must be open...cancelling.",,mtitle Err.Clear ' Clear Err object fields On Error GoTo 0 set ol = nothing wscript.Quit End If ' Set appWord = CreateObject("Word.Application") appword.Documents.Add ' ml1 = myInspector.CurrentItem.FullName ml2 = myInspector.CurrentItem.CompanyName ml3 = myInspector.CurrentItem.BusinessAddressStreet bcity = myInspector.CurrentItem.BusinessAddressCity bstate = myInspector.CurrentItem.BusinessAddressState bzip = myInspector.CurrentItem.BusinessAddressPostalCode bus_str = bcity + ", " + bstate + " " + bzip ml4 = bus_str ' ' Neaten up label, remove blank/duplicate lines. ' If ml1 = ml2 Then ml2 = "" End If ' If ml2 = ml3 Then ml3 = "" End If ' If ml1="" then ml1 = ml2 ml2 = "" End If If ml2="" Then ml2 = ml3 ml3 = "" End If If ml3="" Then ml3 = ml4 ml4 = "" End If crlf = Chr(13) + Chr(10) cliptext = ml1 + crlf + ml2 + crlf + ml3 + crlf + ml4 Response=MsgBox ("Ready to print label(s)... " +crlf+"--------"+crlf+cliptext _ +crlf+"-------"+crlf+"Printer: "+LabelPrinter+crlf+"Label Type: "+LabelType,1,Mtitle) If Response=1 then appWord.Visible = FALSE appword.ActivePrinter = LabelPrinter appword.MailingLabel.DefaultPrintBarCode = False appword.MailingLabel.PrintOut LabelType,cliptext appword.ActivePrinter = DefaultPrinter MsgBox "Printing...Press 'OK' to quit Word when label complete.",,mtitle end if appword.Quit Set appWord = Nothing