Link to home
Start Free TrialLog in
Avatar of betterfasterstranger
betterfasterstrangerFlag for Australia

asked on

Removing fonts in a domain using vbs

I need to uninstall all Helvetica fonts on all PCs across our domain (going to use the login script) and then install just three Helveticas so that our users are faced with only the correct fonts. I have the script to install the fonts working but am struggling with getting the old fonts off first.

I would like an array of the files names of all the fonts to come off (there's maybe two dozen), for the script to check if they exist and if they do then delete the file.  I was just trying to get just one file deleted first but can't seem to get this to actually delete the file in question. I'd love to know what I'm doing wrong...

Thanks in advance,
bfs
delete_File "c$\windows\fonts\HELNLTPR.TTF"
 
Sub delete_File(strFile)
 
  Set oFSO = CreateObject("Scripting.FileSystemObject")
 
  ' If the file exists
  If oFSO.FileExists(strFile) Then
    ' Delete the file
    oFSO.DeleteFile strFile, True
  End if
 
  Set oFSO = Nothing
 
End Sub
 
msgbox "Helveticas have been uninstalled from your PC."

Open in new window

Avatar of RobSampson
RobSampson
Flag of Australia image

Hi, you've got
delete_File "c$\windows\fonts\HELNLTPR.TTF"

shouldn't that be
delete_File "c:\windows\fonts\HELNLTPR.TTF"

Regards,

Rob.
Avatar of betterfasterstranger

ASKER

Hi Rob,

It doesn't work with either...

Thanks,
bfs
OK, we'll just put in two message boxes for debugging....
delete_File "c$\windows\fonts\HELNLTPR.TTF"
 
Sub delete_File(strFile)
 
	Set oFSO = CreateObject("Scripting.FileSystemObject")
 
	' If the file exists
	If oFSO.FileExists(strFile) Then
		' Delete the file
		oFSO.DeleteFile strFile, True
		MsgBox strFile & " was deleted."
	Else
		MsgBox strFile & " was not found."
	End if
 
	Set oFSO = Nothing
 
End Sub
 
msgbox "Helveticas have been uninstalled from your PC."

Open in new window

haha, I just did the same thing ;)

delete_File "c:\windows\fonts\HELNLTPR.TTF"

Sub delete_File(strFile)

  Set oFSO = CreateObject("Scripting.FileSystemObject")

  ' If the file exists
  If oFSO.FileExists(strFile) Then
    ' Delete the file
    oFSO.DeleteFile strFile, True
    msgbox "Helvetica Roman has been uninstalled from your PC."
  Else msgbox "Helvetica Roman not found"
  End if

  Set oFSO = Nothing

End Sub

msgbox "Done"

I think I worked out where I was going wrong. First time I tried it, it came back as successful, but when I went back to C:\Windows\Fonts to check the font was still listed so I thought it was still there. I was looking at a list view so I didn't notice that the file size was 0kb. When I re-ran it, it doesn't find the file of course. So I guess I either need to remove the matching registry key separately, or delete as a shell object? This is how I was installing the correct fonts after removing.

'locate fonts folder & copy fonts into it using the shell
Const FONTS = &H14&

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(FONTS)
objFolder.CopyHere "\\**share location**\HELNLTPB.TTF"
objFolder.CopyHere "\\**share location**\HELNLTPL.TTF"
objFolder.CopyHere "\\**share location**\HELNLTPR.TTF"

msgBox "New versions of Helvetica have been installed on your PC."

I'm just not sure how to call delete_File from the shell? Am a bit of a noob with vbs...

Thanks in advance Rob :)
bfs
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Beautiful, works a treat! Thanks Rob...
Great. Thanks for the grade.

Regards,

Rob.