vbs script to change documents paths do another location

**Guimenez** · March 18, 2010

my batch file install a lots of applications in silent mode and now before everthing,

i want to change the user personal folder with your excelent script. But

when i run this comand in a batch file it close the windowbatch and ask me if i want to terminate the batch file

my batch example:

start /wait "change_personal_folders.hta"

thanks

**Yzöwl** · March 18, 2010

Please gunsmokingman
can an you convert this to vbs?
because i need to run with a batch file and the batch files doesn't runs HTA files
many thanks

The problem with using going down this route is that it removes the interactive nature of requesting a driveletter from the user.

If you wished to do that then I'd suggest you request the drive letter at the command line, this can be input as a result of another script or a simple user input.

I'm not the most proficient vbscripter in the world, (I'm sure that GSM will be able to improve it, or even fix it since it hasn't been tested!), but I'd use something like this:

_Xample.extn

Option Explicit

Dim objAShell, objFSO, objWShell

Dim strChsDst

Dim strMyDocs, strDocsNm

Dim strMyMusc, strMuscNm, strMusPth

Dim strMyPics, strPicPth, strPicsNm

Dim strMyVids, strVidsNm, strVidPth

Dim strProfNm, strUserNm

Set objAShell = CreateObject("Shell.Application")

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objWShell = CreateObject("WScript.Shell")

If WScript.Arguments.Count = 1 Then

strChsDst = WScript.Arguments.Item(0) & ":\"

Else

WScript.Echo("Drive letter not provided as script argument")

WScript.Quit 1

End If

strDocsNm = objAShell.NameSpace(&h5).Self.Name

strMyDocs = objAShell.NameSpace(&h5).Self.Path

strMyMusc = objAShell.NameSpace(&hD).Self.Path

strMuscNm = objAShell.NameSpace(&hD).Self.Name

strMusPth = objFSO.GetParentFolderName(strMyMusc)

strMyPics = objAShell.NameSpace(&h27).Self.Path

strMyVids = objAShell.NameSpace(&hE).Self.Path

strPicPth = objFSO.GetParentFolderName(strMyPics)

strPicsNm = objAShell.NameSpace(&h27).Self.Name

strUserNm = objWShell.ExpandEnvironmentStrings("%UserName%")

strVidPth = objFSO.GetParentFolderName(strMyVids)

strVidsNm = objAShell.NameSpace(&hE).Self.Name

strProfNm = objWShell.ExpandEnvironmentStrings("%UserProfile%")

If strUserNm = "" Then

WScript.Echo("Unable to retrieve current %UserName%")

WScript.Quit 1

End If

If Not objFSO.FolderExists(strChsDst & strUserNm) Then

objFSO.CreateFolder strChsDst & strUserNm

End If

If (objFSO.FolderExists(strMyVids)) Then

If Not strMyVids = strChsDst & strUserNm & "\" & strVidsNm Then

If strVidPth = strProfNm Then

objFSO.MoveFolder strMyVids, strChsDst & strUserNm & "\" & _

strDocsNm

Else

objFSO.MoveFolder strMyVids, strChsDst & strUserNm

End If

Else

If strVidPth = strProfNm Then

objFSO.CreateFolder strChsDst & strUserNm & "\" & strDocsNm & "\" & _

strVidsNm

Else

objFSO.CreateFolder strChsDst & strUserNm & "\" & strVidsNm

End If

If strVidPth = strProfNm Then

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strDocsNm & strVidsNm & Chr(34), "REG_EXPAND_SZ"

Else

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strVidsNm & Chr(34), "REG_EXPAND_SZ"

End If

If (objFSO.FolderExists(strMyPics)) Then

If Not strMyPics = strChsDst & strUserNm & "\" & strPicsNm Then

If strPicPth = strProfNm Then

objFSO.MoveFolder strMyPics, strChsDst & strUserNm & "\" & _

strDocsNm

Else

objFSO.MoveFolder strMyPics, strChsDst & strUserNm

End If

Else

If strPicPth = strProfNm Then

objFSO.CreateFolder strChsDst & strUserNm & "\" & strDocsNm & "\" & _

strPicsNm

Else

objFSO.CreateFolder strChsDst & strUserNm & "\" & strPicsNm

End If

If strPicPth = strProfNm Then

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strDocsNm & strPicsNm & Chr(34), "REG_EXPAND_SZ"

Else

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strPicsNm & Chr(34), "REG_EXPAND_SZ"

End If

If (objFSO.FolderExists(strMyMusc)) Then

If Not strMyMusc = strChsDst & strUserNm & "\" & strMuscNm Then

If strMusPth = strProfNm Then

objFSO.MoveFolder strMyMusc, strChsDst & strUserNm & "\" & _

strDocsNm

Else

objFSO.MoveFolder strMyMusc, strChsDst & strUserNm

End If

Else

If strMusPth = strProfNm Then

objFSO.CreateFolder strChsDst & strUserNm & "\" & strDocsNm & "\" & _

strMuscNm

Else

objFSO.CreateFolder strChsDst & strUserNm & "\" & strMuscNm

End If

If strMusPth = strProfNm Then

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strDocsNm & strMuscNm & Chr(34), "REG_EXPAND_SZ"

Else

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\" _

& "Explorer\User Shell Folders\My Video", & Chr(34) & strChsDst & _

"%UserName%\" & strMuscNm & Chr(34), "REG_EXPAND_SZ"

End If

If (objFSO.FolderExists(strMyDocs)) Then

If Not strMyDocs = strChsDst & strUserNm & "\" & strDocsNm Then

objFSO.MoveFolder strMyDocs, strChsDst & strUserNm

End If

objWShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\" _

& "User Shell Folders\Personal", & Chr(34) & strChsDst & "%UserName%\" & _

strDocsNm & Chr(34), "REG_EXPAND_SZ"

Wscript.Quit 0

In order to use it you could either directly or by another script enter the following command:

Cscript //Nologo //B //E:Vbscript _Xample.extn F

The above would probably produce the following on an XP system

F:\Guimenez\Os meus documentos
F:\Guimenez\Os meus documentos\As minhas imagens
F:\Guimenez\Os meus documentos\A minha m˙sica
F:\Guimenez\Os meus documentos\Os meus vÌdeos

and this on a Vista / 7 system

F:\Guimenez\Os meus documentos
F:\Guimenez\As minhas imagens
F:\Guimenez\A minha m˙sica
F:\Guimenez\Os meus vÌdeos

start /wait "change_personal_folders.hta"

Using the start command like this you'll just have to change it to this:

start "" /wait "change_personal_folders.hta"

**gunsmokingman** · March 18, 2010

Here is what I like about HTA I have now added a self close function to it.

This HTA displays a Bar Graph that counts down from 30 to Zero then closes.


<TITLE>Change Music, Personal, Pictures, Video </TITLE>
<HTA:APPLICATION 
     Id="GsmCloseCntDownVarSized" 
     APPLICATIONNAME="GsmGraphDemo2"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="minimize"
     SELECTION="NO"
     CONTEXTMENU = "NO"
     BORDER="Thin"
     BORDERStyle = "Normal"
     INNERBORDER = "YES"
     NOWRAP
     MAXIMIZEBUTTON = "NO"
     MINIMIZEBUTTON = "NO"
     SYSMENU = "NO">
 <STYLE Type='text/css'>
   Body
    {
     Font-Size:9.75pt;
     Font-Weight:Bold;
     Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
     Color:#203063;
     BackGround-Color:Transparent;
     Filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#ece6e0',endColorStr='#c0bab4');
     Margin-Top:5;
     Margin-Bottom:5;
     Margin-Left:2;
     Margin-Right:2;
     Padding-Top:5;
     Padding-Bottom:5;
     Padding-Left:2;
     Padding-Right:2;
     Text-Align:Center;
     Vertical-Align:Top;
     Border-Top:2px Solid #dbd5d1;
     Border-Bottom:4px Solid #c6c1ba;
     Border-Left:2px Solid #c1bdb9;
     Border-Right:3px Solid #d7d1cb;
    }
   .pgbar 
    {
     filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#44DC88',endColorStr='#005a00')
    }
   BUTTON
   {
    Width:71pt;
    Height:14pt;
    Cursor:Hand;
    Font-Size:8.25pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
    Color:#001137;
    Text-Align:Center;
    Vertical-Align:Middle;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='AliceBlue',endColorStr='LightSlateGray');
    Border-Top:0px Transparent;
    Border-Bottom:0px Transparent;
    Border-Left:0px Transparent;
    Border-Right:0px Transparent;
    Padding-Top:0;
    Padding-Bottom:2;
    Padding-Left:0;
    Padding-Right:0;
    Margin-Top:1;
    Margin-Bottom:1;
    Margin-Left:1;
    Margin-Right:1;
    BackGround-Color:Transparent;
   }
   .B1
   {
    Color:#003711;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='#BAEABA',endColorStr='#226644');
   }
  Select.Bx1
   {
    Font-Size:8.05pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
   }
</STYLE>
 <script LANGUAGE='JScript'>
   var Act = new ActiveXObject("Wscript.Shell");  
   var Fso = new ActiveXObject("Scripting.FileSystemObject");
 </SCRIPT>
  <script LANGUAGE='VBScript'>
 '-> Array To Hold The Reg Keys And Users Folders
 Dim Loc :Loc = Array( _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal - os meus documentos", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures - os meus documentos\As minhas imagens", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music - os meus documentos\A minha m`sica", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video - os meus documentos\Os meus vÌdeos")
  Dim A1, B1, Dir, Obj
  Dim Tx1 :Tx1 = " Seconds Remaining"
'-> Controls The Loop Count Down
  Dim C1 :C1 = 30  
  Function Window_OnLoad()
   self.Focus
   self.resizeTo 395,155
   self.MoveTo screen.availWidth / 2 - 395/2,screen.availHeight / 2 - 155/2
   For Each Obj In Fso.Drives
    If Obj.DriveType = 2 Then
       B1 = B1 + 1
       Set Lst = Document.createElement("OPTION")
        Lst.Text = Obj & "\"
        Lst.Value = Obj & "\"
       If B1 Mod 2 Then
        Lst.style.backgroundcolor = "#D9D9D9" 
        Lst.style.color = "#3A3A3A"
       Else 
        Lst.style.backgroundcolor = "#E9E9E9" 
        Lst.style.color = "#235779" 
       End If
       Drv.Add(Lst)
    End If 
   Next
   bar.style.width = "100%"
   TextDsp("30")
   DemoSelf()
  End Function
'-> The Timer Function
  Function DemoSelf()
   If C1 = 0 Then
     window.close()
    Else
      BarSize(C1)
     TextDsp(C1)
     C1 = C1 - 1
    End If 
   idTimer = window.setTimeout("DemoSelf", 1000, "VBScript")   
  End Function
'-> Resize The Bar
  Function BarSize(N)
    bar.style.width = Left(bar.style.width, Len(bar.style.width) - 1) - 3.3 & "%"
  End Function
'-> Text Display In Bar Graph Area
  Function TextDsp(NM)
   If Len(NM) = 1 Then NM = "0" & NM
    Txt.innerHTML= NM & Tx1
  End Function
'-> Work 
   Function Work(Drv)
    If Drv = "" Then
    alert("Please Input A Drive Letter" & vbcrlf & "Error Number 1")
    Else
     For Each Obj In Loc
       A1 = Split(Obj," - ")
       Dir = Drv & A1(1)
       If Not Fso.FolderExists(Dir) Then Fso.CreateFolder(Dir)
        Act.RegWrite A1(0),Dir 
     Next
    End If 
   End Function
  </SCRIPT>
 <BODY Scroll='No'>
<!-- Text Area -->
  <TABLE>Change Music, Personal, Pictures, Video</TABLE>
  <TABLE Style='Margin:1pt;'>
   <TD><DIV ID='Txt1' Style='Font-Size:8.25pt;Font-Family:Lucida Console;Font-Weight:Bold;Color:#000047;'>
   Select The Drive That You Want To Use For The New User Profile Location
   <TD><Select size='1' Name='Drv' Class='Bx1' Style='width:35pt;' tabindex=1></Select></TD>
  </DIV></TD>
 </TABLE> 
<!-- Button Area -->
  <TABLE Style="Margin-Bottom:5pt;" ><TD>
   <BUTTON ID='Btn01' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='Work(Drv.value)'>Change</BUTTON>
  </TD><TD>
   <BUTTON ID='Btn02' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='C1=0'>Close</BUTTON>
  </TD></TABLE>
<!-- Bar Graph Area -->
 <DIV Align='Left' Style="Margin-Top:5pt;Width:100%;Border-width:1;Border-style:solid;Border-color:#BBBBBB;Font-size:9.25pt">
  <SPAN ID="bar" Class=pgbar></SPAN>
<!-- Text Dispaly Bar Graph Area-->
  <SPAN ID="Txt" Style='Position:Absolute;Bottom:13;Left:117;Font-Family:Lucida Console;Font-Weight:Bold;Color:#003434;'></SPAN>
 </DIV>
</BODY>

**Yzöwl** · March 19, 2010

Thinking about it, I'd suggest that you also remove the %systemdrive% from the list of available drives too!

**Guimenez** · March 19, 2010

Thanks gunsmokingman

with this command: start "" /wait "change_personal_folders.hta"

it works perfectly

your last update its giving me errors on line 139 char 5

please, can you add last things for getting this more perfect?

- remove the %systemdrive% letter (like Yzowl said).

- When choosing the destination drive it will identify if its formated, or not. if not, it will ask if we want to format the destination drive

once again many thanks for all your help,

PS: if this will give you more troubles, forget it, because now its working 100%

Edited March 19, 2010 by Guimenez

**gunsmokingman** · March 19, 2010

I am going to post 2 HTA one so you can work out the format cmd.

Change This To Any Drive Letter To Test This

FormatDrive(Fso.GetDrive('D:'))

Save As DemoDriveFormat.hta


<TITLE>Demo Drive To Cmd Window</TITLE>
<HTA:APPLICATION 
     Id="DemoDrvCmdWindow" 
     APPLICATIONNAME="DrvCmdWindow"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     SELECTION="NO"
     CONTEXTMENU = "NO"
     BORDER="Thin"
     BORDERStyle = "Normal"
     INNERBORDER = "YES"
     NOWRAP
     MAXIMIZEBUTTON = "NO"
     MINIMIZEBUTTON = "NO"
     SYSMENU = "NO">
 <STYLE Type='text/css'>
   Body
    {
     Font-Size:9.75pt;
     Font-Weight:Bold;
     Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
     Color:#203063;
     BackGround-Color:Transparent;
     Filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#ece6e0',endColorStr='#c0bab4');
     Margin-Top:5;
     Margin-Bottom:5;
     Margin-Left:2;
     Margin-Right:2;
     Padding-Top:5;
     Padding-Bottom:5;
     Padding-Left:2;
     Padding-Right:2;
     Text-Align:Center;
     Vertical-Align:Top;
     Border-Top:2px Solid #dbd5d1;
     Border-Bottom:4px Solid #c6c1ba;
     Border-Left:2px Solid #c1bdb9;
     Border-Right:3px Solid #d7d1cb;
    }
   BUTTON
   {
    Width:71pt;
    Height:14pt;
    Cursor:Hand;
    Font-Size:8.25pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
    Color:#001137;
    Text-Align:Center;
    Vertical-Align:Middle;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='AliceBlue',endColorStr='LightSlateGray');
    Border-Top:0px Transparent;
    Border-Bottom:0px Transparent;
    Border-Left:0px Transparent;
    Border-Right:0px Transparent;
    Padding-Top:0;
    Padding-Bottom:2;
    Padding-Left:0;
    Padding-Right:0;
    Margin-Top:1;
    Margin-Bottom:1;
    Margin-Left:1;
    Margin-Right:1;
    BackGround-Color:Transparent;
   }
</STYLE>

 <script LANGUAGE='JScript'>
  window.resizeTo  (325,101)
  window.moveTo(screen.availWidth / 2 - (472/2),screen.availHeight / 2 - (267/2));
   var Act = new ActiveXObject("Wscript.Shell");  
   var Fso = new ActiveXObject("Scripting.FileSystemObject");
/* Button Click Action */
   function TestConfirm()
    {
     var A1 = confirm("Press Ok To Show The Next Function."+'\n'+
                      "Press Cancel To Just Close The Window")
     if(A1==true)
     {
      FormatDrive(Fso.GetDrive('D:'))
     }
     else{alert("User Cancel End Demo");window.close();}
     }
/* Demo Pass Varible To Cmd Window */
    function FormatDrive(DR)
     {
      var Used = DR.TotalSize - DR.FreeSpace
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" +
              "Echo. && Echo Format Test && Echo. && " +
              "Echo Size : " + Math.round(DR.TotalSize/1073741824,2) + " GB && " +
              "Echo Free : " + Math.round(DR.FreeSpace/1073741824,2) + " GB && " +
              "Echo Used : " + Math.round(Used/1073741824,2) + " GB && Pause",1,true); 
      window.close();          
     }
 </SCRIPT>
<BODY Scroll='No'>
 <TABLE>Demo Drive To Cmd Window</TABLE>
 <BUTTON ID='B1' OnClick='TestConfirm()' >Test Me</BUTON>
</BODY>

Updated HTA

1:\ Wont List %SystemDrive% In Listbox

2:\ Demo Code For Formatting Only


<TITLE>Change Music, Personal, Pictures, Video </TITLE>
<HTA:APPLICATION 
     Id="GsmCloseCntDownVarSized" 
     APPLICATIONNAME="GsmGraphDemo2"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     SELECTION="NO"
     CONTEXTMENU = "NO"
     BORDER="Thin"
     BORDERStyle = "Normal"
     INNERBORDER = "YES"
     NOWRAP
     MAXIMIZEBUTTON = "NO"
     MINIMIZEBUTTON = "NO"
     SYSMENU = "NO">
 <STYLE Type='text/css'>
   Body
    {
     Font-Size:9.75pt;
     Font-Weight:Bold;
     Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
     Color:#203063;
     BackGround-Color:Transparent;
     Filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#ece6e0',endColorStr='#c0bab4');
     Margin-Top:5;
     Margin-Bottom:5;
     Margin-Left:2;
     Margin-Right:2;
     Padding-Top:5;
     Padding-Bottom:5;
     Padding-Left:2;
     Padding-Right:2;
     Text-Align:Center;
     Vertical-Align:Top;
     Border-Top:2px Solid #dbd5d1;
     Border-Bottom:4px Solid #c6c1ba;
     Border-Left:2px Solid #c1bdb9;
     Border-Right:3px Solid #d7d1cb;
    }
   .pgbar 
    {
     filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#44DC88',endColorStr='#005a00')
    }
   BUTTON
   {
    Width:71pt;
    Height:14pt;
    Cursor:Hand;
    Font-Size:8.25pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
    Color:#001137;
    Text-Align:Center;
    Vertical-Align:Middle;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='AliceBlue',endColorStr='LightSlateGray');
    Border-Top:0px Transparent;
    Border-Bottom:0px Transparent;
    Border-Left:0px Transparent;
    Border-Right:0px Transparent;
    Padding-Top:0;
    Padding-Bottom:2;
    Padding-Left:0;
    Padding-Right:0;
    Margin-Top:1;
    Margin-Bottom:1;
    Margin-Left:1;
    Margin-Right:1;
    BackGround-Color:Transparent;
   }
   .B1
   {
    Color:#003711;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='#BAEABA',endColorStr='#226644');
   }
  Select.Bx1
   {
    Font-Size:8.05pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
   }
</STYLE>
 <script LANGUAGE='JScript'>
   var Act = new ActiveXObject("Wscript.Shell");  
   var Fso = new ActiveXObject("Scripting.FileSystemObject");
 </SCRIPT>
  <script LANGUAGE='VBScript'>
 '-> Systemdrive Varible
 Dim SD :SD = Act.ExpandEnvironmentStrings("%SystemDrive%")
 '-> Array To Hold The Reg Keys And Users Folders
 Dim Loc :Loc = Array( _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal - os meus documentos", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures - os meus documentos\As minhas imagens", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music - os meus documentos\A minha m`sica", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video - os meus documentos\Os meus vÌdeos")
  Dim A1, B1, Dir, Obj
  Dim Tx1 :Tx1 = " Seconds Remaining"
'-> Controls The Loop Count Down
  Dim C1 :C1 = 30  
  Function Window_OnLoad()
   self.Focus
   self.resizeTo 395,155
   self.MoveTo screen.availWidth / 2 - 395/2,screen.availHeight / 2 - 155/2
   For Each Obj In Fso.Drives
    If Obj.DriveType = 2 Then
     If Not Left(Sd,1) = Left(Obj,1) Then
       B1 = B1 + 1
       Set Lst = Document.createElement("OPTION")
        Lst.Text = Obj & "\"
        Lst.Value = Obj & "\"
       If B1 Mod 2 Then
        Lst.style.backgroundcolor = "#D9D9D9" 
        Lst.style.color = "#3A3A3A"
       Else 
        Lst.style.backgroundcolor = "#E9E9E9" 
        Lst.style.color = "#235779" 
       End If
       Drv.Add(Lst)
     End If 
    End If 
   Next
   bar.style.width = "100%"
   TextDsp("30")
   DemoSelf()
  End Function
'-> The Timer Function
  Function DemoSelf()
   If C1 = 0 Then
     window.close()
    Else
      BarSize(C1)
     TextDsp(C1)
     C1 = C1 - 1
    End If 
   idTimer = window.setTimeout("DemoSelf", 1000, "VBScript")   
  End Function
'-> Resize The Bar
  Function BarSize(N)
    bar.style.width = Left(bar.style.width, Len(bar.style.width) - 1) - 3.3 & "%"
  End Function
'-> Text Display In Bar Graph Area
  Function TextDsp(NM)
   If Len(NM) = 1 Then NM = "0" & NM
    Txt.innerHTML= NM & Tx1
  End Function
'-> Work 
   Function Work(Drv)
    If Drv = "" Then
    confirm("Please Input A Drive Letter" & vbcrlf & "Error Number 1")
    Else
'-> Check To See If Drive Is Formatted In Ntfs Or Fat32
    FormatDrive(Fso.GetDrive(Drv))
     For Each Obj In Loc
       A1 = Split(Obj," - ")
       Dir = Drv & A1(1)
       If Not Fso.FolderExists(Dir) Then Fso.CreateFolder(Dir)
        Act.RegWrite A1(0),Dir 
     Next
    End If 
   End Function
'-> Format The Drive
   Function FormatDrive(DR)
    If Not DR.FileSystem = "ntfs" Or DR.FileSystem = "fat32" Then
'-> Ask The User To Format The Drive
     A1 = confirm( _
        "This Drive Is Not Formatted In Ntfs Or Fat32." & vbcrlf & _
        "Would You Like To Format This Drive In Either,"  & vbcrlf & _
        "The NTFS Or Fat 32 File System.")
'-> Format Drive Code Here
     If A1 = True Then
'-> Add Code To Format EG Remove Echo Format Test Add Format.exe Plus Swiches
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" & _
              "Echo. && Echo Format Test && Pause"),1,true
     End If
     If A1 = False Then
      alert( _
      "Cancel The Change Music, Personal, Pictures, Video"  & vbcrlf & _
      "The User Has Cancel Formatting The Drive In to The"  & vbcrlf & _
      "Correct File System.")
       C1=0 :window.close()
      End If
    End If   
   End Function
  </SCRIPT>
 <BODY Scroll='No'>
<!-- Text Area -->
  <TABLE>Change Music, Personal, Pictures, Video</TABLE>
  <TABLE Style='Margin:1pt;'>
   <TD><DIV ID='Txt1' Style='Font-Size:8.25pt;Font-Family:Lucida Console;Font-Weight:Bold;Color:#000047;'>
   Select The Drive That You Want To Use For The New User Profile Location
   <TD><Select size='1' Name='Drv' Class='Bx1' Style='width:35pt;' tabindex=1></Select></TD>
  </DIV></TD>
 </TABLE> 
<!-- Button Area -->
  <TABLE Style="Margin-Bottom:5pt;" ><TD>
   <BUTTON ID='Btn01' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='Work(Drv.value)'>Change</BUTTON>
  </TD><TD>
   <BUTTON ID='Btn02' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='C1=0'>Close</BUTTON>
  </TD></TABLE>
<!-- Bar Graph Area -->
 <DIV Align='Left' Style="Margin-Top:5pt;Width:100%;Border-width:1;Border-style:solid;Border-color:#BBBBBB;Font-size:9.25pt">
  <SPAN ID="bar" Class=pgbar></SPAN>
<!-- Text Dispaly Bar Graph Area-->
  <SPAN ID="Txt" Style='Position:Absolute;Bottom:13;Left:117;Font-Family:Lucida Console;Font-Weight:Bold;Color:#003434;'></SPAN>
 </DIV>
</BODY>

**Guimenez** · March 20, 2010

Hi gunsmokingman

Thanks for the update.

i'm trying the script and its giving me erros on line 138 (but i've remove that line)

and it works

if i choose any disk it says that its not formatted(even if it is) and after pressing a key

it doesn't format the drive.

Maybe i'm doing someting wrong

thanks

**gunsmokingman** · March 20, 2010

Change This


'-> Format The Drive
   Function FormatDrive(DR)
    If Not DR.FileSystem = "ntfs" Or DR.FileSystem = "fat32" Then
'-> Ask The User To Format The Drive
     A1 = confirm( _
        "This Drive Is Not Formatted In Ntfs Or Fat32." & vbcrlf & _
        "Would You Like To Format This Drive In Either,"  & vbcrlf & _
        "The NTFS Or Fat 32 File System.")
'-> Format Drive Code Here
     If A1 = True Then
'-> Add Code To Format EG Remove Echo Format Test Add Format.exe Plus Swiches
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" & _
              "Echo. && Echo Format Test && Pause"),1,true
     End If
     If A1 = False Then
      alert( _
      "Cancel The Change Music, Personal, Pictures, Video"  & vbcrlf & _
      "The User Has Cancel Formatting The Drive In to The"  & vbcrlf & _
      "Correct File System.")
       C1=0 :window.close()
      End If
    End If   
   End Function

To This


'-> Format The Drive
   Function FormatDrive(DR)
   If InStr(1,DR.FileSystem,"ntfs",1) Or InStr(1,DR.FileSystem,"fat",1) Then
'-> No Code Here 
   Else
'-> Ask The User To Format The Drive
     A1 = confirm( _
        "This Drive Is Not Formatted In Ntfs Or Fat32." & vbcrlf & _
        "Would You Like To Format This Drive In Either,"  & vbcrlf & _
        "The NTFS Or Fat 32 File System.")
'-> Format Drive Code Here
     If A1 = True Then
'-> Add Code To Format EG Remove Echo Format Test Add Format.exe Plus Swiches
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" & _
              "Echo. && Echo Format Test && Pause"),1,true
     End If
     If A1 = False Then
      alert( _
      "Cancel The Change Music, Personal, Pictures, Video"  & vbcrlf & _
      "The User Has Cancel Formatting The Drive In to The"  & vbcrlf & _
      "Correct File System.")
       C1=0 :window.close()
      End If
    End If   
   End Function

**Guimenez** · March 22, 2010

i've made the change and now it gives me another error

i've create a new partition and i didn't format it

and now it gives me error on the script in this line

If InStr(1,DR.FileSystem,"ntfs",1) Or InStr(1,DR.FileSystem,"fat",1) Then

character (4)

if its formatted it works fine now . now its the unformatted problem

thanks

**gunsmokingman** · March 22, 2010

I am kinda of lost as to why you want to format! In my testing with a drive that had no filesystem EG Raw Disk,

the hta does not pick it up. The hta picks up only Fixed Hard drives that have a filesystem EG Fat or NTFS.

If all you want to do is make sure that the drive is NTFS and not Fat then try this hta.

I have tested this to see if it would work at picking up the fat drive, and asking to convert to NTFS.

You will still have to add the code for formatting the drive to NTFS.


<TITLE>Change Music, Personal, Pictures, Video </TITLE>
<HTA:APPLICATION 
     Id="GsmCloseCntDownVarSized" 
     APPLICATIONNAME="GsmGraphDemo2"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     SELECTION="NO"
     CONTEXTMENU = "NO"
     BORDER="Thin"
     BORDERStyle = "Normal"
     INNERBORDER = "YES"
     NOWRAP
     MAXIMIZEBUTTON = "NO"
     MINIMIZEBUTTON = "NO"
     SYSMENU = "NO">
 <STYLE Type='text/css'>
   Body
    {
     Font-Size:9.75pt;
     Font-Weight:Bold;
     Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
     Color:#203063;
     BackGround-Color:Transparent;
     Filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#ece6e0',endColorStr='#c0bab4');
     Margin-Top:5;
     Margin-Bottom:5;
     Margin-Left:2;
     Margin-Right:2;
     Padding-Top:5;
     Padding-Bottom:5;
     Padding-Left:2;
     Padding-Right:2;
     Text-Align:Center;
     Vertical-Align:Top;
     Border-Top:2px Solid #dbd5d1;
     Border-Bottom:4px Solid #c6c1ba;
     Border-Left:2px Solid #c1bdb9;
     Border-Right:3px Solid #d7d1cb;
    }
   .pgbar 
    {
     filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#44DC88',endColorStr='#005a00')
    }
   BUTTON
   {
    Width:71pt;
    Height:14pt;
    Cursor:Hand;
    Font-Size:8.25pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
    Color:#001137;
    Text-Align:Center;
    Vertical-Align:Middle;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='AliceBlue',endColorStr='LightSlateGray');
    Border-Top:0px Transparent;
    Border-Bottom:0px Transparent;
    Border-Left:0px Transparent;
    Border-Right:0px Transparent;
    Padding-Top:0;
    Padding-Bottom:2;
    Padding-Left:0;
    Padding-Right:0;
    Margin-Top:1;
    Margin-Bottom:1;
    Margin-Left:1;
    Margin-Right:1;
    BackGround-Color:Transparent;
   }
   .B1
   {
    Color:#003711;
    Filter:progid:DXImageTransform.Microsoft.Gradient
    (StartColorStr='#BAEABA',endColorStr='#226644');
   }
  Select.Bx1
   {
    Font-Size:8.05pt;
    Font-Weight:Bold;
    Font-Family:Segoe Ui, Lucida Console, Arial, Tahoma, Comic Sans MS;
   }
</STYLE>
 <script LANGUAGE='JScript'>
   var Act = new ActiveXObject("Wscript.Shell");  
   var Fso = new ActiveXObject("Scripting.FileSystemObject");
 </SCRIPT>
  <script LANGUAGE='VBScript'>
 '-> Systemdrive Varible
 Dim SD :SD = Act.ExpandEnvironmentStrings("%SystemDrive%")
 '-> Array To Hold The Reg Keys And Users Folders
 Dim Loc :Loc = Array( _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal - os meus documentos", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures - os meus documentos\As minhas imagens", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music - os meus documentos\A minha m`sica", _
  "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video - os meus documentos\Os meus vÌdeos")
  Dim A1, B1, Dir, Tmr, Obj
  Dim Tx1 :Tx1 = " Seconds Remaining"
'-> Controls The Loop Count Down
  Dim C1 :C1 = 30  
  Function Window_OnLoad()
   self.Focus
   self.resizeTo 395,155
   self.MoveTo screen.availWidth / 2 - 395/2,screen.availHeight / 2 - 155/2
   Graph.style.visibility = ""
   For Each Obj In Fso.Drives
    If Obj.DriveType = 2 Then
     If Not Left(Sd,1) = Left(Obj,1) Then
       B1 = B1 + 1
       Set Lst = Document.createElement("OPTION")
        Lst.Text = Obj & "\"
        Lst.Value = Obj & "\"
       If B1 Mod 2 Then
        Lst.style.backgroundcolor = "#D9D9D9" 
        Lst.style.color = "#3A3A3A"
       Else 
        Lst.style.backgroundcolor = "#E9E9E9" 
        Lst.style.color = "#235779" 
       End If
       Drv.Add(Lst)
     End If 
    End If 
   Next
   bar.style.width = "100%"
   TextDsp("30")
   DemoSelf()
  End Function
'-> The Timer Function
  Function DemoSelf()
   If C1 = 0 Then
     window.close()
    Else
      BarSize(C1)
     TextDsp(C1)
     C1 = C1 - 1
    End If 
   Tmr = window.setTimeout("DemoSelf", 1000, "VBScript")   
  End Function
'-> Resize The Bar
  Function BarSize(N)
    bar.style.width = Left(bar.style.width, Len(bar.style.width) - 1) - 3.3 & "%"
  End Function
'-> Text Display In Bar Graph Area
  Function TextDsp(NM)
   If Len(NM) = 1 Then NM = "0" & NM
    Txt.innerHTML= NM & Tx1
  End Function
'-> Work 
   Function Work(Drv)
    If Drv = "" Then
    confirm("Please Input A Drive Letter" & vbcrlf & "Error Number 1")
    Else
'-> Check To See If Drive Is Formatted In Ntfs Or Fat32
    FormatDrive(Fso.GetDrive(Drv))
     For Each Obj In Loc
       A1 = Split(Obj," - ")
       Dir = Drv & A1(1)
      If Not Fso.FolderExists(Dir) Then Fso.CreateFolder(Dir)
       Act.RegWrite A1(0),Dir 
     Next
    End If
    alert("Completed, User Change Music, Personal, Pictures, Video Locations"):window.close()
   End Function
'-> Format The Drive
   Function FormatDrive(DR)
    If InStr(1,DR.FileSystem,"fat",1) Then
'-> Ask The User To Format The Drive
     A1 = confirm( _
        "This Drive Is Not Formatted In Ntfs, Current FileSystem : " & DR.FileSystem & "." & vbcrlf & _
        "Would You Like To Format This Drive In To The NTFS Disk FileSystem." & vbcrlf & _
        "Ok To Continue The Format, Cancel To Close And Exit The Program")
'-> Format Drive Code Here
     If A1 = True Then
'-> Add Code To Format EG Remove Echo Format Test Add Format.exe Plus Swiches
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" & _
              "Echo. && Echo Format Test && Pause"),1,true
     End If
     If A1 = False Then
      alert( _
      "Cancel The Change Music, Personal, Pictures, Video"  & vbcrlf & _
      "The User Has Cancel Formatting The Drive In to The"  & vbcrlf & _
      "Correct File System.")
       C1=0 :window.close()
      End If
    End If   
   End Function
'-> Stop Timer And Hide The Bar Graph
   Function ClearTheCountDown()
    Graph.style.visibility = "hidden"
    window.clearTimeout(Tmr)
   End Function
  </SCRIPT>
 <BODY Scroll='No'>
<!-- Text Area -->
  <TABLE>Change Music, Personal, Pictures, Video</TABLE>
  <TABLE Style='Margin:1pt;'>
   <TD><DIV ID='Txt1' Style='Font-Size:8.25pt;Font-Family:Lucida Console;Font-Weight:Bold;Color:#000047;'>
   Select The Drive That You Want To Use For The New User Profile Location
   <TD><Select size='1' Name='Drv' Class='Bx1' Style='width:35pt;' tabindex=1 OnChange='ClearTheCountDown()'></Select></TD>
  </DIV></TD>
 </TABLE> 
<!-- Button Area -->
  <TABLE Style="Margin-Bottom:5pt;" ><TD>
   <BUTTON ID='Btn01' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='Work(Drv.value)'>Change</BUTTON>
  </TD><TD>
   <BUTTON ID='Btn02' OnMouseOver="this.className='B1'" OnMouseOut="this.className=''" OnClick='C1=0,window.close()'>Close</BUTTON>
  </TD></TABLE>
<!-- Bar Graph Area -->
 <DIV Align='Left' ID='Graph' 
  Style="Visibility:Hidden;Margin-Top:5pt;Width:100%;Border-width:1;Border-style:solid;Border-color:#BBBBBB;Font-size:9.25pt">
  <SPAN ID="bar" Class=pgbar></SPAN>
<!-- Text Dispaly Bar Graph Area-->
  <SPAN ID="Txt" Style='Position:Absolute;Bottom:13;Left:117;Font-Family:Lucida Console;Font-Weight:Bold;Color:#003434;'></SPAN>
 </DIV>
</BODY>

**Guimenez** · April 1, 2010

Sorry for my late reply, but i don't know why, i didn't see the reply message

Ok this is my situation:

When i install Windows, i create 2 partitions c:(OS) and d:(Backup purpose)

After installing Windows, the 2nd partition (d:) it's not formatted and if i change documents do 2nd partition

without formating it will give me errors, all i want its, after choosing the destination drive(fat ou ntfs) it will

verify if its formatted, if not, it will format the partition and then change the personal folder locations.

Thanks once again and sorry for my late reply

Guimenez

**gunsmokingman** · April 1, 2010

Here is a problem if the drive is not formatted in any filesystem, then my script wont pick up the drive.

I think you would have to use the diskpart to perform what you need. I have no experience at using diskpart,

so I can not help you on this part of the project.

Microsoft DiskPart version 6.1.7600
Copyright © 1999-2008 Microsoft Corporation
On computer: HOME-BETA-2008
Microsoft DiskPart syntax:
diskpart [/s <script>] [/?]
/s <script> - Use a DiskPart script.
/? - Show this help screen.

**jaclaz** · April 1, 2010

Here is a problem if the drive is not formatted in any filesystem, then my script wont pick up the drive.

Are you sure?

If the partiion is created (even if not formatted) a drive letter should be assigned to it, otherwise FORMAT could not work.

jaclaz

**Guimenez** · April 1, 2010

thats true jaclaz

the script detects the drive D: (because it exists on windows)

now i just need to format the destination drive if its not formatted

thanks

guimenez

**gunsmokingman** · April 1, 2010

Please read the code, it only checks for Fat and only has place holder code for the format.

This would be the reason it is not working, you will have to add your own code. jaclaz I thought

you would have notice that was missing from the code.


'-> Format The Drive
   Function FormatDrive(DR)
    If InStr(1,DR.FileSystem,"fat",1) Then
'-> Ask The User To Format The Drive
     A1 = confirm( _
        "This Drive Is Not Formatted In Ntfs, Current FileSystem : " & DR.FileSystem & "." & vbcrlf & _
        "Would You Like To Format This Drive In To The NTFS Disk FileSystem." & vbcrlf & _
        "Ok To Continue The Format, Cancel To Close And Exit The Program")
'-> Format Drive Code Here
     If A1 = True Then
'-> Add Code To Format EG Remove Echo Format Test Add Format.exe Plus Swiches
      Act.Run("Cmd.exe /C @Echo Off && CLS && MODE 69,9 && COLOR F9 &&" & _
              "Echo. && Echo Format Test && Pause"),1,true
     End If
     If A1 = False Then
      alert( _
      "Cancel The Change Music, Personal, Pictures, Video"  & vbcrlf & _
      "The User Has Cancel Formatting The Drive In to The"  & vbcrlf & _
      "Correct File System.")
       C1=0 :window.close()
      End If
    End If   
   End Function

Sign In

vbs script to change documents paths do another location

Recommended Posts

Guimenez

Yzöwl

gunsmokingman

Yzöwl

Guimenez

gunsmokingman

Guimenez

gunsmokingman

Guimenez

gunsmokingman

Guimenez

gunsmokingman

jaclaz

Guimenez

gunsmokingman

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members

Activity

Browse