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!!! :)

Use SpecialFolders...

Code:

---

set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")

---

Quote:

---

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!!!

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"

---

Great! Thank you very much!