CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 5 of 5
  1. #1
    Join Date
    Jun 2012
    Posts
    3

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

  2. #2
    Join Date
    May 2002
    Posts
    10,943

    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.

  3. #3
    Join Date
    Jun 2012
    Posts
    3

    Thumbs up Re: Absolute path problem

    Quote Originally Posted by PeejAvery View Post
    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!!!

  4. #4
    Join Date
    May 2002
    Posts
    10,943

    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.

  5. #5
    Join Date
    Jun 2012
    Posts
    3

    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
  •  





Click Here to Expand Forum to Full Width

Featured