|  | 
| 本帖最后由 9zhmke 于 2021-12-16 18:51 编辑 
 先检测是否有这个字体,没有字体再安装,例:
 复制代码
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set font = CreateObject("Shell.Application").NameSpace("shell:fonts")
tmp0=Wscript.CreateObject("Wscript.Shell").SpecialFolders("fonts") & ""'字体文件所在文件夹
for each f in objFSO.getfolder(".").files '文件夹所有文件
    tmp1=LCase(f.path)'完整文件名和路径
    tmp2=right(tmp1,3)'扩展名
    tmp3=asc(left(right(tmp1,4),1)):if tmp3=49 then tmp3=46 '我也不知道为什么取出来居然不是".",只知和系统有关
    if tmp3<>46 or objFSO.FileExists(tmp0 & LCase(f.name)) then tmp2="" '扩展名容错或容错fonts下已装字体
    if tmp2="ttf" or tmp2="ttc" or tmp2="otf" or tmp2="fon" then  font.CopyHere(tmp1)
next
 
 | 
 |