[技术讨论] 批量安装字体的VBS脚本Folder.CopyHere 方法中的参数问题

holley

现有批量安装字体的VBS脚本

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)
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[color=Red],256[/color]
    END IF
NEXT
复制代码

测试在未安装对应字体的电脑上使用正常
但如果已安装对应字体则会弹出是否覆盖的确定窗口，手动一个个点击确认太麻烦了
查了一下微软相关的方法调用：https://docs.microsoft.com/ja-jp ... ell/folder-copyhere
发现我添加的参数都未正常生效  想请教一下 是这个可选参数只能在特定环境下生效还是我的脚本错误导致这种情况

flashercs

oWinFonts.CopyHere FontFile.Path,16+256
复制代码

holley

回复 2# flashercs
貌似没啥效果，win10 x64测试。
想添加直接发送enter键 居然也不生效。

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)
Set rxTTF = New RegExp
rxTTF.IgnoreCase = True
rxTTF.Pattern = "\.ttf|ttc|otf$"
' rxTTF.Pattern = "\.otf$"
set WshShell = CreateObject("WScript.Shell")
FOR EACH FontFile IN oSource.Items()
    IF rxTTF.Test(FontFile.Path) THEN
		WScript.Sleep 800
        oWinFonts.CopyHere FontFile.Path,16+256
		WScript.Sleep 800
		WshShell.AppActivate "安装字体"
		WshShell.SendKeys "{ENTER}"
    END IF
	WScript.Sleep 800
	WshShell.AppActivate "安装字体"
	WshShell.SendKeys "{ENTER}"
NEXT
复制代码

flashercs

回复 3# holley


    以管理员身份运行vbs可以发送按键