• 0

[VB] Help copying/installing fonts via command line


Question

I need for users to be able to install fonts to their system without admin privileges at work. We have a system set up that installs software from a defined database that runs as SYSTEM, and that is working well so far.

I had thought that copying font files to the WINDOWS\Fonts directory would be enough to install them, but apparently it is not.

So I found a VB script that copies .ttf files to the Fonts directory using the Windows shell, causing the font to be properly registered. This runs at system startup as SYSTEM, so it has write permission to the directory. All they have to do is copy their new fonts to a directory on the file server and restart their system.

on error resume next
Const FONTS = &H14
dim oFSO, oShell, oFolder1, oFolder2, sRoot
sRoot="\\fileserver\Shared\company\fonts"
Set oShell = CreateObject("Shell.Application")
set oFSO=createobject("scripting.filesystemobject")
Set oFolder1 = oShell.Namespace(FONTS)
set oFolder2 = oFSO.getfolder(sRoot)
for each oFile in oFolder2.files
    sName=lcase(oFile.name)
    if right(sName,4)=".ttf" then
      if not ofso.fileexists(oFolder1.self.path & "\" & sName) then
        oFolder1.copyhere sRoot & "\" & sName
      end if
    end if
next
on error goto 0

The problem is that this only copies files to the local system if they do not already exist there. I had been using robocopy to copy them over, but that wasn't registering them.

So now what I need to do is to figure out how to copy over fonts that are not correctly registered in HKLM\Software\Microsoft\Windows NT\Fonts

Alternatively, I need to be able to automatically delete .ttf files from the local system that are not correctly registered in that same registry key. I definitely don't want to go through the 1,500+ fonts manually.

I also need to be able to copy over .ttf, .otf, .fon and any other font extensions that are possible.

I don't know anything about VB script. Can someone explain how to make that go or write up something that would do that?

6 answers to this question

Recommended Posts

  • 0

Does anyone know of another forum where other experts may be able to assist if nobody here knows? Anyone have a friend who might know the answer? Google's not much help except to teach me VB from scratch, which I'm not really up for just to do this one thing.

  • 0

hi,

the issue here is that putting fonts in the correct folder is not enough to make them work. they need to be registered with the windows registry...

when you double click (or drag) a font into the folder this act registers it with the system..

so, you have two options really..

1. is to execute a registry patch to manually register the font for use

2. reboot the system which i believe will force them to be registered

i think registry patch would be the best way to go... good luck! :)

  • 0

This copies them correctly so that they get registered. This is already doing what needs to be done.

But...

I had copied them wrong in the past using robocopy, so now there are lots of fonts in their Fonts folders that are not correctly registered.

Is there a VB way to view a list from the registry of the fonts that are installed, then skip those when copying fonts over to the computer?

for each regfontname in regkey

if (fontname == regfontname)

continue

else

copy font

or something like that?

(FYI: rebooting doesn't do it. If it did, that would be great, but it doesn't. It has to be copied using the shell, either drag and drop, or using something like this script.)

  • 0

Alternative that we're going to try:

we're going to comment out the 'if not ofso.fileexists' line (and its corresponding end if) and run that. That should hopefully we think maybe copy over all of the fonts whether they need to be copied or not.

Once that has run on each computer, we can uncomment those lines again so that it only installs new fonts when it runs in the future instead of trying to install all 1700 again.

[edit]

Fail.

If the font is already registered, the copy process comes up with an error message. I'm not going to sit and click OK 1,000+ times.

Other thoughts? How can we compare against the registry?

[/edit]

The question remains though:

how can I include more than one file extension? What's the VB command for "or"?

if right(sName,4)=".ttf" or ".otf" or ".fon" then

  • 0
  Quote

how can I include more than one file extension? What's the VB command for "or"?

if right(sName,4)=".ttf" or ".otf" or ".fon" then

 If Right(sName,4) = ".ttf" Or  Right(sName,4) = ".otf"  Or  Right(sName,4) = ".fon" Then
 '-> Your Code Here
 End If

This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.
  • Posts

    • Due to upgrade (PC built in summer 2023). Lian Li O11 Dynamic EVO Black be quiet! Pure Power 12 M 850W ASRock X670E Steel Legend AMD Ryzen 9 7950X3D Boxed G.Skill Trident Z5 Neo RGB F5-6000J2836G16GX2-TZ5NRW NZXT Kraken Elite 360 RGB Zwart 2x Lian Li UNI FAN SL120, 1-pack, Zwart, 120mm 2x Lian Li UNI FAN SL120, 3-pack, Zwart, 120mm Lian Li Universal Vertical Gen4 GPU Riser-kit) MSI GeForce RTX 4070 VENTUS 2X 12G OC WD Black SN850X (no heatsink) 1TB Lexar NM710 2TB M2 Network card Marvell AQC113 10G/5G/2.5G/1000M Current worth to build €2,805 Receipts and original boxes included Notes: Lian Li Universal Vertical Gen4 GPU Riser-kit was bought second-hand SPDIF port cable holder broke (but works) Never been overclocked (except EXPO values) Includes ASRock Thunderbolt 4 AIC in box (not been used due to too few internal USB ports) 2nd Lian Li UNI FAN SL120, 1-pack, Black, 120mm in box (no time to build in rear of case) I am asking €1,800 on a local marketplace in The Netherlands, and although it has been favorited 4x I am only getting lowball offers. It was first listed on May 14. Would I be more successful selling without the video card?
    • Lifetime subscription to Mail Backup X gets price dropped by 72% by Steven Parker Today's highlighted deal comes via our Apps + Software section of the Neowin Deals store, where you can save 72% off a lifetime subscription to Mail Backup X Individual. For most individuals and organizations, emails are the most critical part of daily activities and communications. Some of us realize the importance of backing up emails only when critical emails are lost for some reason. Plan ahead and safeguard your mail data today with a robust and reliable mail backup solution. Mail Backup X is a one-stop solution for mail backup, archiving, email management & mail conversion trusted by 42,000+ business and home users worldwide. Backup from major mail clients. Apple Mail, Microsoft Outlook, Office 365, Microsoft Exchange, Thunderbird, Postbox Backup from mail services. Gmail, Outlook.com, Yahoo, Gmx.de, Office365, Microsoft Exchange, or any service supporting IMAP protocol Archive file viewer. Quickly search & view your emails from archives Highly compressed archives. Save up to 3x storage space Import almost any mail archive. Files like .pst, .ost, .mbox, .olk, .eml, .rge, and more Mirror backup. Cloud storage (Google Drive, One Drive, Dropbox, Pcloud or FTP) or USB drive Restore. Restore direct to the server account or a separate server account Migration. Move all mails onto a new account in Office365 100% privacy. Encrypt & secure your data with military-grade aes 256-bit encryption and your own private key, so it's only visible to you Top-notch premium support. Get help that you need from experts Good to know Plan: Individual Edition Length of access: lifetime Redemption deadline: redeem your code within 30 days of purchase Access options: desktop Max number of devices: 2 Only available to new users Version: 2 Updates included A lifetime subscription to Mail Backup X normally costs $179, but you can pick this up for just $49.99 for a limited time - that represents a saving of $129 (72% off). For a full description, spec, and terms, click the link below. Get Mail Backup X (lifetime plan) for just $49.99 (was $179) Use coupon code SAVE20 at checkout to get this product for an additional 20% off We post these because we earn commission on each sale so as not to rely solely on advertising, which many of our readers block. It all helps toward paying staff reporters, servers and hosting costs. Other ways to support Neowin Whitelist Neowin by not blocking our ads Create a free member account to see fewer ads Make a donation to support our day to day running costs Subscribe to Neowin - for $14 a year, or $28 a year for an ad-free experience Disclosure: Neowin benefits from revenue of each sale made through our branded deals site powered by StackCommerce.
    • I will believe it when it happens. iOS 18 was heavily rumoured to be a massive overhaul with visionOS glass style UI elements. Never happened. I don't even believe the x26 naming scheme is real either, feels more like an April fools joke *shrugs* I'll be happy to be proven wrong. However, till Apple themselves say it's so I will remain skeptical.
  • Recent Achievements

    • Reacting Well
      brynmot earned a badge
      Reacting Well
    • Week One Done
      Al_ earned a badge
      Week One Done
    • Week One Done
      MadMung0 earned a badge
      Week One Done
    • Reacting Well
      BlakeBringer earned a badge
      Reacting Well
    • Reacting Well
      Lazy_Placeholder earned a badge
      Reacting Well
  • Popular Contributors

    1. 1
      +primortal
      477
    2. 2
      +FloatingFatMan
      274
    3. 3
      ATLien_0
      243
    4. 4
      snowy owl
      209
    5. 5
      Edouard
      182
  • Tell a friend

    Love Neowin? Tell a friend!