install font programmatically

[Bruce Hensley]

I need to allow users to programmatically install a Type 1 (.PFM + .PFB)
font from our fileserver for use by a Word 2000 template on our intranet.
Our platforms are Win 2000.

I cannot target the 50-200 users who might need the template and font out of
our 2000 user base, so an automatic install triggered by loading the
template would be preferred, however, I could do it in Word VBA, VBScript,
or JScript, and as a separate install script if needed.

The installation can be permanent or temporary (for use while a document
based on the template is open).

Based on my Googling, I tried the following in VBA (within the template) for
a temporary install, but it reports 0 (no files installed).

I'm open to any suggestions or alternatives.

Thanks,
Bruce

'----------
Private Declare Function AddFontResource Lib "gdi32" Alias
"AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias
"AddFontResourceA" (ByVal lpFileName As String) As Long
Const FONTFILE =
"\\server\share\folder\fontname.PFB|\\server\share\folder\fontname.PFM"
Dim tmp As Long

Private Sub Document_Close()
tmp = RemoveFontResource(FONTFILE)
MsgBox tmp
End Sub

Private Sub Document_New()
MsgBox FONTFILE
tmp = AddFontResource(FONTFILE)
MsgBox tmp
End Sub

Private Sub Document_Open()
tmp = AddFontResource(FONTFILE)
MsgBox tmp
End Sub

 

[Bruce Hensley]

I was able to find a TrueType version of the font. The following code
installed it temporarily. There is no need to use RemoveFontResource to get
rid of it. SendMessage seems to be needed to make the font available in
documents created from the template.


Private Declare Function AddFontResource Lib "gdi32" Alias
"AddFontResourceA" (ByVal lpFileName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long

Const HWND_BROADCAST = &HFFFF&
Const WM_FONTCHANGE = &H1D
Const FONTFILE = "\\server\share\fonts\font.ttf"

Private Sub Document_New()
AddFontResource FONTFILE
SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0
End Sub

Private Sub Document_Open()
AddFontResource FONTFILE
SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0
End Sub