Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Combining a VBScript with an .HTA (Create GUI to get User Input) 1

Status
Not open for further replies.
dbe123

dbe123

Technical User
Apr 3, 2009
10
GB
Hi all,

I'm having difficulties integrating a VBScript to an HTA.
In fact, the VBScript will synchronize 2 directories, checking if files have changed.

The script works fine, and now i'd like to have some User input. This user input will be achieved by using a HTA.
I'd like the users to have a Dropdown-box for selecting the source folder (as these paths will be fixed), and I also want to allow the users to Browse for the destination folder.

Next, after clicking a button, the synchronisation will start, and I'd like to display a progress bar showing the status of the copying progress.

I'm not succeeding in doing this.
Can anyone help me?

I've posted the VBScript code on the url below:

Thanks
 
Sort by date Sort by votes
You can provide a button that runs your code:

[tt]<INPUT Type=Button Value="Go" OnClick="SearchFiles()">[/tt]

You can refer to the dropdown box by name:
[tt]FileToSearch=Document.All.FolderList.Value[/tt]

Or ID:

Code: 
Set dd = Document.getElementById("FolderList")
p=dd.Options(dd.selectedIndex).Text

MsgBox "You picked: " & p

You can add options to your drop down (select: with code:

Code: 
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\")

Set dd = Document.getElementById("FolderList")

i=0

For Each fl In f.SubFolders
Dim opt: Set opt = Document.createElement("option")
    opt.Value = i
    opt.Text = fl.Path & fl.Name
    dd.add opt
    i=i+1
Next

 
Upvote 0 Downvote
Hi Remou,

Thanks for your reply.
This helped me a lot...

I'm still unable to display the progress of the copy process.

My code so far:

Code: 
<html>
<head><title>LocalWeb Update Utility</title>
<HTA:APPLICATION ID="oHTA";
  APPLICATIONNAME="LocalWeb Update Utility";
  ICON="Backup.ico";
  BORDER="thin";
  BORDERSTYLE="normal";
  SINGLEINSTANCE="no";
  MAXIMIZEBUTTON="no";
  VERSION="1.0";
  CONTEXTMENU="no";

>
</head><body bgcolor="#E8E8E8" >
<font size=2 face="Century Gothic, Tahoma, Arial" color="black">

<script language="VBScript" type="text/vbscript">

Sub Sync

	If browseFolder.value = "" Then
		MsgBox "Please enter a valid path to save the files.", 1, "Error"
	Else
		Const SOURCE_FOLDER = "SERVER.value"
		Const DESTINATION_FOLDER = "browseFolder.value"

		Dim oFSO

		Set oFSO = CreateObject("Scripting.FileSystemObject")
		ReplicateFolders oFSO, SOURCE_FOLDER, DESTINATION_FOLDER
	End If

End Sub

'******************
' Sub ReplicateFolders
'
' This procedure replicates between the source and the destination
' directories at the folder level. A recursive search is done
' between the 2 directories and folders compared. If a particular
' folder on the source does not exist on the destination at any level then the
' source folder and all folders and files associated with it are
' copied to the destination. If a particular folder on the destination
' does not exist on the source at any level then the destination folder
' is removed from the destination directory.
'
'******************


Sub ReplicateFolders (oFSO, strSourcefolderpath, strDestinationfolderpath)
	
	Dim aFolderArraySource
	Dim aFolderArrayDestination
	Dim FolderListSource
	Dim FolderListDestination
	Dim oFolderSource
	Dim oFolderDestination
	Dim bSourceExists
	Dim bDestinationExists
	
	On Error Resume Next
	
	Set aFolderArraySource = oFSO.GetFolder(strSourcefolderpath)
	Set aFolderArrayDestination = oFSO.GetFolder(strDestinationfolderpath)
	Set FolderListSource = aFolderArraySource.SubFolders
	Set FolderListDestination = aFolderArrayDestination.SubFolders
	
	' Compare to see if destination folder does not exist. If it does not
	' then copy from the source.
	
	For Each oFolderSource in FolderListSource
		bDestinationExists = 0
		For each oFolderDestination in FolderListDestination
			If oFolderSource.Name = oFolderDestination.Name then
				bDestinationExists = 1
				Exit For
			End If
		Next
		If bDestinationExists = 0 then
			oFolderSource.Copy strDestinationfolderpath & "\"
		Else
			'This is the recursive bit. Traverse the path one level down
			ReplicateFolders oFSO, strSourcefolderpath & "\" & oFolderSource.Name, strDestinationfolderpath & "\" & oFolderDestination.Name
		End if
	Next
	' After taking care of the folders, deal with the files at each folder level.
	ReplicateFiles oFSO, strSourcefolderpath, strDestinationfolderpath


	' Compare to see if a folder on the destination drive does not exist
	' in the source directory. If this is the case then delete the destination
	' folder.
	
	For Each oFolderDestination in FolderListDestination
		bSourceExists = 0
		For each oFolderSource in FolderListSource
			If oFolderDestination.Name = oFolderSource.Name then
				bSourceExists = 1
				Exit For
			End If
		Next
		If bSourceExists = 0 then
			oFSO.DeleteFolder strDestinationfolderpath & "\" & oFolderDestination.Name, true
		End if
	Next
	
End Sub


'******************
' Sub ReplicateFiles
'
' This procedure replicates between the source and the destination
' directories at the file level.
' If a particular file on the source does not exist on the destination
' at any level then the source file is copied to the destination.
' If a particular file on the destination directory
' does not exist on the source at any level then the destination file
' is removed from the destination directory.
'
'******************


Sub ReplicateFiles (oFSO, strSourcefolderpath, strDestinationfolderpath)
	
	
	Dim aFileArraySource
	Dim aFileArrayDestination
	Dim FileListSource
	Dim FileListDestination
	Dim	oFileSource
	Dim oFileDestination
	Dim bSourceExists
	Dim bDestinationExists
	Dim intFCount
	Dim i
	Dim intPercentComplete
	
	On Error Resume Next
	
	Set aFileArraySource = oFSO.GetFolder(strSourcefolderpath)
	Set aFileArrayDestination = oFSO.GetFolder(strDestinationfolderpath)
	Set FileListSource = aFileArraySource.Files
	Set FileListDestination = aFileArrayDestination.Files
	
	' Comparing the array entry properties (name and date last modified) of each array.
	' If the source file array entry matches the destination file array entry then
	' the source file is not copied to the destination directory.
	' Otherwise, the source file is copied to the destination directory and
	' any existing copy of the same file in the destination directory
	' is overwritten.
	
	i = 0
	intFCount = 0
	intPercentComplete = 0
	
	For each oFileSource in FileListSource
		bDestinationExists = 0
		For each oFileDestination In FileListDestination
			If oFileSource.Name = oFileDestination.Name Then
				If oFileSource.DateLastModified = oFileDestination.DateLastModified AND o.FileSource.Size = oFileDestination.Size then
					bDestinationExists = 1
					Exit For
				End If
			End If
		Next
		If bDestinationExists = 0 Then
			intFCount = intFCount + 1
			oFileSource.Copy strDestinationfolderpath & "\" & oFileSource.Name
			i = i + 1
			intPercentComplete = (i * 100) / intFCount
			Wscript.Echo intPercentComplete & "% copy of total " & intFCount & " files complete"
			
		End If
	Next
	
	' Comparing the array entry properties (name and date last modified) of each array.
	' If the destination file array entry matches the source file array entry then
	' the destination file is not deleted from the destination directory.
	' Otherwise, the destination file is deleted from the destination directory.
	
	For each oFileDestination In FileListDestination
		bSourceExists = 0
		For each oFileSource In FileListSource
			If oFileDestination.Name = oFileSource.Name then
				If oFileDestination.DateLastModified = oFileSource.DateLastModified Then
					bSourceExists = 1
					Exit For
				End If
			End If
		Next
		If bSourceExists = 0 Then
			oFSO.DeleteFile strDestinationfolderpath & "\" & oFileDestination.Name,true
		End If
	Next
End Sub

Sub ChooseSaveFolder
	strStartDir = "c:\"
	browseFolder.value = PickFolder(strStartDir)
End Sub

Function PickFolder(strStartDir)
	Dim SA, F
	Set SA = CreateObject("Shell.Application")
	Set F = SA.BrowseForFolder(0, "Choose the LocalWeb Folder", 0)
	If (Not F Is Nothing) Then
  	
	PickFolder = F.Items.Item.path
	End If
	Set F = Nothing
	Set SA = Nothing
End Function 
</script>


<p><b>This application will update your version of the LocalWeb.<br>
      Choose the source and destination directory you desire, <br>and click the Update-button.<br><br>
      <font color="red">P.S.: </font>When updating from your home, please make sure<br>
      that your VPN connection is up and running.</b><hr noshode color="#000000"><br></p>
    <p></p>
    <table>
	<tr>
	<td>Source:</td>
	<td><select name="SERVER">
			<option selected value="Y:\test1">SERVER VILVOORDE (DEFAULT)</option>
        </select></td></tr>
	<tr></tr>
	<tr>
	<td>Destination:</td>
	<td><input type="text" name="browseFolder" size="50">
	<input name="browseButton" type = "button" value = "Browse ..." onClick="ChooseSaveFolder"></td></tr></table>
    <p align=center><input type="submit" name="B1" value="Update"  onclick="Sync"></p>
<div id=LogOut></div>
<script language="JavaScript">
<!--
	if (window.resizeTo) self.resizeTo(600,400);
//-->
</script>
</body>
</html>
 
Upvote 0 Downvote
Remou,

I saw that Thread, but I'm unable to implement it in my script.
Another thing: this opens in a new window, which I don't want.

I would like the <div></div> named "LogOut" to display the progress.

One more thing I saw in my code, the declaration of the Source & Destination folders was wrong.

The code
Code: 
        Const SOURCE_FOLDER = "SERVER.value"
        Const DESTINATION_FOLDER = "browseFolder.value"

should be

Code: 
        Const SOURCE_FOLDER = SERVER.value
        Const DESTINATION_FOLDER = browseFolder.value
 
Upvote 0 Downvote
You could do set up a 'to do' count:

[tt]document.getElementById("LogOut").innerHTML="To do " & string(aFolderArraySource.SubFolders.Count,"|")[/tt]

And reduce it in each iteration:
[tt]i=i+1
document.getElementById("LogOut").innerHTML="To do " & string(aFolderArraySource.SubFolders.Count-i,"|")
[/tt]


 
Upvote 0 Downvote
Thanks for the tip.

I've modified my code as below


I get the progressbar to display now, and the copying process still works after clicking the button.
Every file is copied, which is just fine.

The progress bar however, keeps incrementing till he reaches value "1", then it freezes.

Any idea? My guess is that during the FOR-loop, something goes wrong.

The goal is to increment the progressbar per file that is copied.

This means, that 2 things will have to be changed:
1. the <param id="Max1" name="Max" value="100"> has to be dynamically changed. The value should be the number of files that has to be copied (maximum number BEFORE the copying process starts)
2. a counter needs to be implemented. Initially this will be set to 0, and has to be increased with every file that has been copied. This value should be added to the ProgressBar1.Value
 
Upvote 0 Downvote
Hello,
I have idea, how the problem will be solve...

First run "For each" to check count of the files which will copy from source folder:
Code: 
mycount = 0
For each oFileSource in FileListSource
  mycount = mycount + 1
Next
After that calculate length of the Progress bar:
Code: 
ProgressBar1.Value = (i * 100) / mycount
Replace This part of your code:
Code: 
If bDestinationExists = 0 Then
Wscript.Sleep 200
ProgressBar1.Value = ProgressBar1.Value + i
oFileSource.Copy strDestinationfolderpath & "" & oFileSource.Name
msgbox i
End If
With this:
Code: 
If bDestinationExists = 0 Then
Wscript.Sleep 200
oFileSource.Copy strDestinationfolderpath & "" & oFileSource.Name
ProgressBar1.Value = (i * 100) / mycount
End If
I try many times and work properly! :)
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
812
SoftwareRT
SoftwareRT
Alexvb6
  • Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
95
Alexvb6
Alexvb6
bdwilcox
  • Locked
  • Question
HTA fails with Syntax Error when working VBScript inserted
Replies
2
Views
242
bdwilcox
bdwilcox
K
  • Question
VBSCRIPT dont work windows 11 23h2 ???
Replies
2
Views
256
SoftwareRT
SoftwareRT
bdwilcox
  • Locked
  • Question
Validate that HTA text input boxes aren't blank on submission
Replies
1
Views
196
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top