同时安装多个字体，能不能实现显示第n个字体，共50个字体?

15126222223

使用VBS安装字体非常方便，但麻烦的事情是只能安装一个一个文件，不会显示很多个，如“正在安装xxxx字体，第1个字体，共1个字体”，我希望能够实现显示“正在安装xxx字体，第6个字体，共24个字体。这样的效果，求各位大佬帮忙解决一下？

我希望自动安装，但一个一个安装，出现系统已经有的，要点击是否覆盖才行，能不能直接覆盖，不提示。
能否把替换提示改为默认替换就行？



本论坛中一个一个安装原代码

1. Set ofso = CreateObject("Scripting.FileSystemObject")
   
2. 
   
3. SourceFolder = ofso.GetParentFolderName(Wscript.ScriptFullName)
   
4. 
   
5. 
   
6. Const FONTS = &H14&
   
7. 
   
8. 
   
9. Set objShell  = CreateObject("Shell.Application")
   
10. 
    
11. Set oSource   = objShell.Namespace(SourceFolder)
    
12. 
    
13. Set oWinFonts = objShell.Namespace(FONTS)
    
14. 
    
15. 
    
16. ' Lame VBscript needs 4 f*ing lines instead of "if (/\.ttf$/i) " ...
    
17. 
    
18. Set rxTTF = New RegExp
    
19. 
    
20. rxTTF.IgnoreCase = True
    
21. 
    
22. rxTTF.Pattern = "\.ttf[        DISCUZ_CODE_0        ]quot;
    
23. 
    
24. 
    
25. FOR EACH FontFile IN oSource.Items()
    
26. 
    
27.     IF rxTTF.Test(FontFile.Path) THEN
    
28.    
    
29.         oWinFonts.CopyHere FontFile.Path
    
30. 
    
31.     END IF
    
32. 
    
33. NEXT

复制代码

junyee

不要用 For Each;
直接把所有路径用分隔符（可能是;或,) 连接在一起．试试吧．

15126222223

常用的方法有逗号分隔、分号分隔、回车换行分隔、放到数组，试过了这几种都不行。

邪恶海盗

字体安装不是直接复制到fonts目录就行了么?

15126222223

邪恶海盗 发表于 2021-5-10 10:34
字体安装不是直接复制到fonts目录就行了么?

现在win10复制安装不成功。

15126222223

edison_2008 发表于 2021-5-10 14:00
亲测，可以。

有部分系统复制进去，不识别，重启不行。

邪恶海盗

15126222223 发表于 2021-5-10 14:31
有部分系统复制进去，不识别，重启不行。

还有这事???

nttwqz

edison_2008 发表于 2021-5-10 14:00
亲测，可以。

楼主指的可能是非手动复制，命令或者程序复制可能就不会安装

15126222223

nttwqz 发表于 2021-5-10 14:55
楼主指的可能是非手动复制，命令或者程序复制可能就不会安装

是的，第一种，用命令写进去的。第二种用winrar软件打包成exe，运行路径就是字体安装路径，两种会出现问题，字体无效。

nttwqz

15126222223 发表于 2021-5-10 15:37
是的，第一种，用命令写进去的。第二种用winrar软件打包成exe，运行路径就是字体安装路径，两种会出现问 ...

本坛有个fontreg
复制完成后运行一下就好

dos时代菜鸟

把系统里的这个字体先删掉

15126222223

dos时代菜鸟 发表于 2021-5-12 19:26
把系统里的这个字体先删掉

两种方法，一种就是判断是否安装，一种就是安装前删除。
我选择第一种。

gsg666

一个个来也快

1588965

感谢分享

redyear2026

   修改一楼代码如下，取消原有的进度显示（改用命令行显示，如楼主期望格式），取消覆盖确认提示。
   代码存为 test.vbs，与要安装的 *.ttf 字体文件同目录，命令行运行 test.vbs 的用法格式须为 cscript test.vbs，不要双击运行 test.vbs 以免出现弹窗显示等待。

1. Set ofso=CreateObject("Scripting.FileSystemObject")
   
2. SourceFolder=ofso.GetParentFolderName(Wscript.ScriptFullName)
   
3. Const FONTS=&H14&
   
4. Set objShell=CreateObject("Shell.Application")
   
5. Set oSource=objShell.Namespace(SourceFolder)
   
6. Set oWinFonts=objShell.Namespace(FONTS)
   
7. n=0 : m=0
   
8. FOR EACH FontFile IN oSource.Items()
   
9.     IF Lcase(ofso.GetExtensionName(FontFile))="ttf" THEN
   
10.         n=n+1
    
11.     END IF
    
12. NEXT
    
13. FOR EACH FontFile IN oSource.Items()
    
14.     IF Lcase(ofso.GetExtensionName(FontFile))="ttf" THEN
    
15.         m=m+1
    
16.         wsh.echo "正在安装 " & FontFile & "，第" & m  & "个字体，共" & n & "个字体"
    
17.         oWinFonts.CopyHere FontFile.Path, 20
    
18.     END IF
    
19. NEXT
    
20. WSH.Quit

复制代码

15126222223

redyear2026 发表于 2026-4-9 23:00
修改一楼代码如下，取消原有的进度显示（改用命令行显示，如楼主期望格式），取消覆盖确认提示。
   代 ...

非常感谢楼主，我测试一下。

redyear2026

   如果要保留原有进度框，可采用 copyHere 方法一次性安装指定目录中的全部字体文件，其全量进度框显示也许会如你所愿，代码如下，存为 test.vbs，运行方法是直接将被安装的字体文件目录拖拽给 test.vbs 即可。
   注意：
   一。test.vbs 不要放在被安装的字体文件目录中
   二。被安装的字体文件目录只能存放字体文件（如 *.ttf, *.ttc）

1. Set v=WSH.arguments
   
2. If v.count = 0 Then WSH.Quit
   
3. SourceFolder=v(0)
   
4. Const FONTS=&H14&
   
5. Set objShell=CreateObject("Shell.Application")
   
6. Set WinFonts=objShell.Namespace(FONTS)
   
7. WinFonts.CopyHere objShell.Namespace(SourceFolder).Items,16
   
8. WSH.Quit

复制代码

心升明月

ctrl+A所有字体,右键菜单安装，完事

redyear2026

   15，17楼代码只是简单给系统内置的 copyhere 字体安装方法加持了启动参数 16（取消覆盖确认框），20（取消覆盖确认框+进度框），但在 win11 高版系统经实测均无效。
   用17楼代码或用16楼手动全选+右键安装方法（即系统内置方法）会有全量进度框显示，如弹窗须确认覆盖，只须首次回复即可 - 【推荐采用】
   坚持用脚本安装且不调用系统安装方法 copyhere，只能尝试 '强行复制字体文件+强行注册字体文件+刷新字体缓存' 的方法了。
   值得注意的是，用系统内置的右键字体安装方法可以周全管理维护从复制/替换/注册/清理缓存等所有环节，尤其是还要细分字体文件的内部名称（即字形名），如粗细斜体等字体特征（可被 word, photoshop 和网页等识别应用），而只用 vbs 代码不能直接处理，甚至用管理员身份都很难删除系统字符目录中的内置字体文件。