Jump to content

vbs script to change documents paths do another location


Recommended Posts

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

Link to comment
Share on other sites


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

End If

Else

If strVidPth = strProfNm Then

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

strVidsNm

Else

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

End If

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

End If

Else

If strPicPth = strProfNm Then

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

strPicsNm

Else

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

End If

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

End If

Else

If strMusPth = strProfNm Then

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

strMuscNm

Else

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

End If

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

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"
Link to comment
Share on other sites

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.

CountDownChangeUserProfile.png


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

Link to comment
Share on other sites

Thanks gunsmokingman

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

it works perfectly :D

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 by Guimenez
Link to comment
Share on other sites

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>

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 :D. now its the unformatted problem

thanks

Link to comment
Share on other sites

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>

Link to comment
Share on other sites

  • 2 weeks later...

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Are you sure? :unsure:

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

jaclaz

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...