Creating Separator Page via VbScript - Problem with outline font

The following is a vbscript file that creates a simulation of a PCL
separator page.
I am using a version in a VB application that is running on a server
and prints documents
directly from the server. The VB application provides a UserId to this
routine to embed
the UserId in the separator page and then prepends this file in front
of the document
print-stream.

It works fine except that the UserId is very dark because of it's
size. I would prefer to
use an outline font or something else that would not use so much
toner.

I have preceded the lines in question with
"******************************".

Thanks in advance for any help.
Tim

PS If you know of a more appropriate area for this posing, please let
me know.
++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++

Option Explicit

Call BannerTest

Sub BannerTest() 'BannerTest
Dim sFName, sPrinter, sPath
sPrinter = "\\Dcpp100\z_HP52$"
sFName = "XXX.pcl"
sPath = GetVbsPath ' Script Path
If CreateBannerPS(sPath, sFName, "TBS2", sPrinter) Then
PrintDoc sPath & sFName, sPrinter
End If
Msgbox "Banner Sheet printed to: " & Replace(Replace(Replace(sPrinter,
"z_", ""), "$", ""), "\\", "")
End Sub

'Creates Banner Sheet Print-Stream file
Function CreateBannerPS(ByVal Path, ByVal FName, ByVal UserId, ByVal
sPrinter)
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
CreateBannerPS = "False"
'On Error Resume Next
Set ts = fso.CreateTextFile(Path & FName, True) 'Overwrites existing
file
'If Err.Number = 58 Then Exit Function
'File already exists
'ts.WriteLine "%-12345X@PJL SET PAGEPROTECT=OFF"
ts.WriteLine "%-12345X@PJL ENTER LANGUAGE=PCL" 'Enter PCL
language
ts.WriteLine "E" 'Printer Reset
ts.WriteLine "*t600R" 'Resolution - 600 DPI
ts.WriteLine "&u600D" 'Unit-of-Measure - units per inch
ts.WriteLine "*r0F" 'Presentation
ts.WriteLine "&l0o1E" 'Top Margin
ts.WriteLine "&l0S" 'Simplex/Duplex
ts.WriteLine "&l7H" 'Paper Source
ts.WriteLine "&l2a8c1E" 'Top Margin
ts.WriteLine "*p0x0Y" 'Units of Measure
ts.WriteLine "*c0t5760x7704Y" '???
ts.WriteLine "&l1X" 'Number of copies
ts.WriteLine "*b0M" 'Compression mode
ts.WriteLine "(19U(s4099t0b0s10h0P" 'Font Id, Typeface, Stroke
weight, style, pitch, spacing
ts.WriteLine "&d@" 'Underline disable
ts.WriteLine "*v0o0T" 'transparency mode, current
pattern
ts.WriteLine "*p415Y
*p330X=========================================== ================="
ts.Write "(19U" 'Symbol set - Windows ANSI
ts.Write "(s4099T" 'Typeface - Courier (Scalable)
'ts.Write "(s3t" 'Typeface - Courier
'ts.Write "(s16602T" 'Typeface - Arial
'ts.Write "(s-4B" 'Stroke Weight: -4 Extra Light - Does
not seem to work
'ts.Write "(s160S" 'Style: 0-Upright, 1-Italic, 32-
Outline - Does not seem to work
'ts.Write "(s0.75H" 'Pitch - characters per inch
'ts.Write "(s0P" 'Spacing - 0 for fixed, 1 for
proportional
'Ec (0UEc (s0PEc (s10HEc (s12VEc (s0SEc (s3BEc (s3T

'******************************
ts.WriteLine "(0U(s0P(s0.75H(s12V(s0S(s3B(s3T"
'Upright - works
'ts.WriteLine "(0U(s0P(s0.75H(s12V(s1S(s3B(s3T"
'Italic - works
'ts.WriteLine "(0U(s0P(s0.75H(s12V(s32S(s3B(s3T"
'Outline - Does not work 'ts.WriteLine
"(0U(s0P(s0.75H(s12V(s24S(s3B(s3T" 'expanded -
Does not work
'ts.WriteLine
"(0U(s0P(s0.75H(s12V(s160S(s3B(s3T" 'Outline/
shadow - Does not work

ts.WriteLine "*p1600Y *p600X" & UserId
ts.WriteLine "(19U(s4099t0b0s10h0P&d@"
ts.WriteLine "*p2200Y *p330XPrint Server:*p1225X" &
Replace(Replace(Replace(sPrinter, "z_", ""), "$", ""), "\\", "")
ts.WriteLine "*p2300Y *p330XDate Printed:*p1225X" & MMDDYYYY(Now)
ts.WriteLine "*p2400Y *p330XTime Printed:*p1225X" & HHNNSS(Now)
ts.WriteLine "*p2600Y
*p330X=========================================== ================="
ts.Close: Set ts = Nothing: Set fso = Nothing
If Err.Number = 0 Then CreateBannerPS = True
End Function

Function HHNNSS(strIn) 'Formats time in Hh:Nn:Ss AM/PM format
Dim tmpDate
If IsDate(strIn) = False Then
HHNNSS = "Time Err"
Else
tmpDate = CDate(strIn)
HHNNSS = Mdd(Hour(tmpDate)) &":" & Mdd(Minute(tmpDate)) &":" &
Mdd(Second(tmpDate))
If Hour(tmpDate) > 12 then
HHNNSS = HHNNSS & " PM"
Else
HHNNSS = HHNNSS & " AM"
End If
End If
End Function

Function MMDDYYYY(strIn) 'Formats Date in MM/DD/YYYY format
Dim tmpDate
If IsDate(strIn) = False Then
MMDDYYYY = "Date Err"
Else
tmpDate = CDate(strIn)
MMDDYYYY = Mdd(Month(tmpDate)) &"/" & Mdd(Day(tmpDate)) &"/" &
Right(Year(tmpDate),4)
End If
End Function

Function Mdd(strIn) 'Make Double Digit
If Len(strIn) = 1 Then
Mdd = "0" & strIn
Else
Mdd = strIn
End If
End Function

Sub PrintDoc(sPathFName, sPrinter)
Dim WshShell,sCopy
Set WshShell = CreateObject("WScript.Shell")
sCopy="cmd /C ""copy /b " & sPathFName & " " & sPrinter & Chr(32)
WshShell.Run sCopy,0,False
Set WshShell = Nothing
End Sub

Function GetVbsPath() 'Returns path of Script file
Dim arrayScr, sTmp, i
arrayScr = Split(WScript.ScriptFullName, "\", -1, 1)
For i = 0 to UBound(arrayScr) - 1
sTmp = sTmp & arrayScr(i) & "\"
Next
GetVbsPath = sTmp
End Function