-
June 4th, 2012, 10:53 AM
#1
Absolute path problem
Hello Everybody!
Sorry for my bad english!
I have great great VBScript which helps me to install fonts!
But I want to change the absolute path "C:\Documents and Settings\Administrator\Desktop\Fonts" with %userprofile%\Desktop
Code:
Const FONTS = &H14&
Const ForAppending = 8
Dim fso
doexist = 0
dontexist = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(FONTS)
set oShell = CreateObject("WScript.Shell")
strSystemRootDir = oshell.ExpandEnvironmentStrings("%systemroot%")
strFontDir = strSystemRootDir & "\fonts\"
strTempDir = oshell.ExpandEnvironmentStrings("%systemroot%") & "\temp"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
objDictionary.CompareMode = TextMode
Set f1 = FSO.createTextFile(strTempDir & "\installed_fonts.txt", ForAppending)
CollectFonts
InstallFonts "C:\Documents and Settings\Administrator\Desktop\Fonts" ' insert path here to font folder
wscript.echo doexist & " fonts already installed." & vbcrlf & dontexist & " new fonts installed."
'===================================================================
Public Sub CollectFonts
'===================================================================
set colItems = objfolder.Items
For each ObjItem in ColItems
If LCase(Right(objItem.Name, 3)) = "ttf" or _
LCase(Right(objItem.Name, 3)) = "otf" or _
LCase(Right(objItem.Name, 3)) = "pfm" or _
LCase(Right(objItem.Name, 3)) = "fon" Then
If Not objDictionary.Exists(LCase(ObjItem.Name)) Then
objDictionary.Add LCase(ObjItem.Name), LCase(ObjItem.Name)
End If
End If
Next
For each ObjItem in ObjDictionary
f1.writeline ObjDictionary.Item(objItem)
Next
End Sub
'===================================================================
Public Sub InstallFonts(Folder)
'===================================================================
Set FontFolder = fso.getfolder(Folder)
For Each File in FontFolder.Files
If LCase(fso.GetExtensionName(File))="ttf" or _
LCase(fso.GetExtensionName(File))="otf" or _
LCase(fso.GetExtensionName(File))="pfm" or _
LCase(fso.GetExtensionName(File))="fon" Then
'check if Font is Already installed. If not, Install
If objDictionary.Exists(lcase(fso.GetFileName(File))) then
' wscript.echo fso.GetFileName(File) & " already exists in " & strFontDir
doexist = doexist + 1
Else
' wscript.echo fso.GetAbsolutePathName(File) & " doesn't exists in " & strFontDir
objFolder.CopyHere FontFolder & "\" & fso.GetFileName(File)
dontexist = dontexist + 1
end If
End If
Next
For Each SubFolder in FontFolder.subFolders
InstallFonts SubFolder
Next
End Sub
How can I do that?
Please help me!
Thank you very much!!!
-
June 4th, 2012, 11:29 AM
#2
Re: Absolute path problem
Use SpecialFolders...
Code:
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
If the post was helpful...Rate it! Remember to use [code] or [php] tags.
-
June 20th, 2012, 12:40 PM
#3
Re: Absolute path problem
Originally Posted by PeejAvery
Use SpecialFolders...
Code:
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
Thank you VERY much,PeejAverey,for your reply and help!!!
But...
I am more newbie that you think!
I added your code in script before path an then change the path into "Desktop",but it doesnt work. Maybe it will be better if I use the relative path instead of variables? Like ".\" or "\"? Or it wont work?
P.S. Please give me the link of great VBS tutorial or videocourse! Please!
Thank you VERY much!!!
-
June 20th, 2012, 02:55 PM
#4
Re: Absolute path problem
Add what I gave you right above your InstallFonts path. Then change the line to include the string I gave you.
Code:
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
InstallFonts = strDesktop & "\Fonts"
If the post was helpful...Rate it! Remember to use [code] or [php] tags.
-
July 7th, 2012, 04:49 PM
#5
Re: Absolute path problem
Great! Thank you very much!
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|