Невозможно установить шрифт с помощью VBScript из-за исключения "Требуется объект: 'objFolderItem'"
Вот мой сценарий на основе Как установить шрифт из командной строки Windows?
Dim WinFontDir
Dim SrcFontDir
WinFontDir = "C:\Windows\Fonts"
SrcFontDir = "..\fonts.test"
Set objShell = CreateObject("Shell.Application")
Set objFontFolder = objShell.Namespace(WinFontDir)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSrc = objFSO.GetFolder(SrcFontDir)
Set colFiles = objSrc.Files
For each objFile in colFiles
If objFSO.FileExists(WInFontDir + "\" + objFile.Name) Then
WScript.Echo objFile.Name
else
WScript.Echo "Copying " + objFile.Name
objFSO.CopyFile SrcFontDir + "\" + objFile.Name, WinFontDir + "\" + objFile.Name
Set objFolderItem = objFontFolder.ParseName(objFile.Name)
objFolderItem.InvokeVerb("Install") // <- exception
End If
Next
По сути, я хочу иметь возможность перебирать папку со шрифтами, и копировать и устанавливать только в том случае, если файл шрифта не существует в "C:\Windows\Fonts".
Но когда дело доходит до этой линии objFolderItem.InvokeVerb("Install") Я получил это сообщение об ошибке:
Обязательный объект: 'objFolderItem'
В чем причина?
1 ответ
Решение
В конце концов, у меня работает только так:
Dim WinFontDir
Dim SrcFontDir
WinFontDir = "C:\Windows\Fonts"
SrcFontDir = "..\fonts"
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSrc = objFSO.GetFolder(SrcFontDir)
Set colFiles = objSrc.Files
For each objFile in colFiles
If Not objFSO.FileExists(WInFontDir + "\" + objFile.Name) Then
WScript.Echo "Copying " + objFile.Name
FONTS = &H14&
Set objFontFolder = objShell.Namespace(FONTS)
objFontFolder.CopyHere objFile.Path
End
Next
Примечание. Копируйте только те файлы, которые не существуют в папке шрифтов.