[问题求助] 同时安装多个字体，能不能实现显示第n个字体，共50个字体?[未解决]

9zhmke

使用VBS安装字体非常方便，如下语句即可。

CreateObject("Shell.Application").NameSpace("shell:fonts").CopyHere(font_filename)
复制代码

但麻烦的事情是只能安装一个文件，做文件夹遍历过后，要等显示很多个“正在安装xxxx字体，第1个字体，共1个字体”，我希望能够实现显示“正在安装xxx字体，第6个字体，共24个字体。这样的效果，尝试了把文件名字串用逗号隔开结果不行，放到数组里也不行，要怎么样才能安装多个字体文件呢？

Set objFSO = CreateObject("Scripting.FileSystemObject")
tmp0=Wscript.CreateObject("Wscript.Shell").SpecialFolders("fonts") & "\"'字体文件所在文件夹
for each f in objFSO.getfolder(".").files '文件夹所有文件
    tmp1=LCase(f.path)'完整文件名和路径
    tmp2=right(tmp1,3):if left(right(tmp1,4),1)<>"." then tmp2=""       '取扩展名，扩展容错
    if objFSO.FileExists(tmp0 & LCase(f.name)) then tmp2=""'判断fonts下的是否有字体，容错已安装字体
    if tmp2="ttf" or tmp2="ttc" or tmp2="otf" or tmp2="fon" then
          CreateObject("Shell.Application").NameSpace("shell:fonts").CopyHere(tmp1)
    end if
next
复制代码

9zhmke

回复 3# 窄口牛


    谢谢指点，这个还没有我写那个完善.... 这不是重点，可能我没有写清楚，我的问题想问怎么实现同时安装多个字体而不是一个一个安装，你这个程序仍然会提示安装一个总数一个，虽然使用了正则表达式但和我那个在本质上没有区别？

窄口牛

记得在无忧讨论过
转载

Set ofso = CreateObject("Scripting.FileSystemObject")
SourceFolder = ofso.GetParentFolderName(Wscript.ScriptFullName)

Const FONTS = &H14&

Set objShell  = CreateObject("Shell.Application")
Set oSource   = objShell.Namespace(SourceFolder)
Set oWinFonts = objShell.Namespace(FONTS)

' Lame VBscript needs 4 f*ing lines instead of "if (/\.ttf$/i) " ...
Set rxTTF = New RegExp
rxTTF.IgnoreCase = True
rxTTF.Pattern = "\.ttf$"

FOR EACH FontFile IN oSource.Items()
    IF rxTTF.Test(FontFile.Path) THEN   
        oWinFonts.CopyHere FontFile.Path
    END IF
NEXT
复制代码

9zhmke

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