批处理之家 - Powered by Discuz! Board

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

作者: holley 时间: 2021-12-13 12:24 标题: 批量安装字体的VBS脚本Folder.CopyHere 方法中的参数问题

现有批量安装字体的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 时间: 2021-12-14 11:54

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

作者: holley 时间: 2021-12-15 09:28

回复 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 时间: 2021-12-15 11:15

回复 3# holley

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

欢迎光临批处理之家 (http://bathome.net./)