Randomize Outlook Signature with VBScript

Posted Friday, December 17, 2010 in Old JamesCMS Posts

Here's a simple script to randomizes the signature block in outlook each time it is ran.

{{VBScript}}
On Error Resume Next

Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
    Set objWord = CreateObject("Word.Application")
    blnWeOpenedWord = True
End If
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObjects = objWord.EmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObjects.EmailSignatureEntries

'randomize
Dim max,min
max=6
min=0
Randomize
randomNumber=Int((max-min+1)*Rnd+min)
dim randomStuff

Select Case randomNumber
  Case 0
    randomStuff = "CISSP"
  Case 1
    randomStuff = "MCITP"
  Case 2
    randomStuff = "MCPD"
  Case 3
    randomStuff = "B.S. CMIS"
  Case 4
    randomStuff = "ITIL V3"
  Case 5
    randomStuff = "S+"
  Case 6
    randomStuff = "A+"
  Case Else
    randomStuff = "CISSP"
End Select


objSelection.TypeText "V/R"
objSelection.TypeParagraph
objSelection.TypeText "John Smith, " & randomStuff
objSelection.TypeParagraph
objSelection.TypeText "Door Stop"
objSelection.TypeParagraph
objSelection.TypeText "Global National "

Set objSelection = objDoc.Range()

objSignatureEntries.Remove "Rando"
objSignatureEntries.Add "Rando", objSelection
objSignatureObjects.NewMessageSignature = "Rando"
objSignatureObjects.ReplyMessageSignature = "Rando"

objDoc.Close 0
If blnWeOpenedWord Then
    objWord.Quit
End If