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!

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

VBS Help :-(

Status
Not open for further replies.

kaiserclaw

Technical User
Apr 3, 2014
2
SE
Hi there!

I'm trying to get my script to work. I want to use a simple copy function with progressbar. Works! BUT I don't know how to exclude files (.mp3) ex. and overwrite without promt..

Here is my code:


Option Explicit
Dim oSHApp
Dim sSrc, sDest
Const FOF_SIMPLEPROGRESS = 256

Set oSHApp = CreateObject("Shell.Application")

sSrc = "C:\test\*.*"
sDest = "D:\test"

oSHApp.Namespace(sDest).CopyHere sSrc

Set oSHApp = nothing
WScript.Quit


Please help!

Thank you
 
overwrite without prompt
oSHApp.Namespace(sDest).CopyHere sSrc, 16 + 256

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hi
You can also try this script :

Code:
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "C:\Downloads"
sDest = "E:\XCopytest"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
MyCmd = "XCopy" & " " & sSrc & " " & sDest & " /F /I /E /Y  > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & " "
Titre = "Copying files " & Copyright
MsgAttente = "Copying files from <font color=Yellow>" & DblQuote(sSrc) & " to " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
FermerProgressBar()
ws.run LogFile
'************************************************************************************
 Function Executer(StrCmd,Console)
	Dim ws,MyCmd,Resultat
	Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
	If Console = 0 Then
		MyCmd = "CMD /C " & StrCmd & " "
		Resultat = ws.run(MyCmd,Console,True)
		If Resultat = 0 Then
			'MsgBox "Success"
		Else
			MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
		End If
	End If
'La valeur 1 pour montrer la console MS-DOS
	If Console = 1 Then
		MyCmd = "CMD /K " & StrCmd & " "
		Resultat = ws.run(MyCmd,Console,False)
		If Resultat = 0 Then
			'MsgBox "Success"
		Else
			MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
		End If
	End If
	Executer = Resultat
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
	Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
	Set ws = CreateObject("wscript.Shell")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Temp = WS.ExpandEnvironmentStrings("%Temp%")
	PathOutPutHTML = Temp & "\Barre.hta"
	Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
	fhta.WriteLine "<HTML>"
	fhta.WriteLine "<HEAD>"
	fhta.WriteLine "<Title>  " & Titre & "</Title>"
	fhta.WriteLine "<HTA:APPLICATION"
	fhta.WriteLine "ICON = ""magnify.exe"" "
	fhta.WriteLine "BORDER=""THIN"" "
	fhta.WriteLine "INNERBORDER=""NO"" "
	fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
	fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
	fhta.WriteLine "SCROLL=""NO"" "
	fhta.WriteLine "SYSMENU=""NO"" "
	fhta.WriteLine "SELECTION=""NO"" "
	fhta.WriteLine "SINGLEINSTANCE=""YES"">"
	fhta.WriteLine "</HEAD>"
	fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
	fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
	fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
	fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
	fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
	fhta.WriteLine "Sub window_onload()"
	fhta.WriteLine "    CenterWindow 480,90"
	fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
	fhta.WriteLine " End Sub"
	fhta.WriteLine " Sub CenterWindow(x,y)"
	fhta.WriteLine "    Dim iLeft,itop"
	fhta.WriteLine "    window.resizeTo x,y"
	fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
	fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
	fhta.WriteLine "    window.moveTo ileft,itop"
	fhta.WriteLine "End Sub"
	fhta.WriteLine "</script>"
	fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
	Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
	oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
	Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
 
Thank you! :) The script works very well, but how do I use an exclude function? Exclude all .mp3 files in the directory?

 
Hi [peace]
If you mean to exclude all the .mp3 files ; You should do like this [2thumbsup]

Code:
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "C:\Downloads"
sDest = "E:\XCopytest"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
MyExcludeFile = "echo .mp3 > MyExcludeFile.txt" 'This file must be created and contains .mp3 to exclude in the first line
'**************************************************************************************************************************
'Remark : You can also add some other filters like this :
'for example, if you want to exculde all .exe files with all .mp3 files, you should write this variable like this : 
'MyExcludeFile = "echo .mp3 > MyExcludeFile.txt & echo .exe >> MyExcludeFile.txt" 
'and so on .....
'**************************************************************************************************************************
Call Executer(MyExcludeFile,0)
MyCmd = "XCopy" & " " & sSrc & " " & sDest & " /F /I /E /Y /EXCLUDE:MyExcludeFile.txt > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & " & Del MyExcludeFile.txt"
Titre = "Copying files " & Copyright
MsgAttente = "Copying files from <font color=Yellow>" & DblQuote(sSrc) & " to " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
 Function Executer(StrCmd,Console)
	Dim ws,MyCmd,Resultat
	Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
	If Console = 0 Then
		MyCmd = "CMD /C " & StrCmd & " "
		Resultat = ws.run(MyCmd,Console,True)
		If Resultat = 0 Then
			'MsgBox "Success"
		Else
			MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
		End If
	End If
'La valeur 1 pour montrer la console MS-DOS
	If Console = 1 Then
		MyCmd = "CMD /K " & StrCmd & " "
		Resultat = ws.run(MyCmd,Console,False)
		If Resultat = 0 Then
			'MsgBox "Success"
		Else
			MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
		End If
	End If
	Executer = Resultat
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
	Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
	Set ws = CreateObject("wscript.Shell")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Temp = WS.ExpandEnvironmentStrings("%Temp%")
	PathOutPutHTML = Temp & "\Barre.hta"
	Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
	fhta.WriteLine "<HTML>"
	fhta.WriteLine "<HEAD>"
	fhta.WriteLine "<Title>  " & Titre & "</Title>"
	fhta.WriteLine "<HTA:APPLICATION"
	fhta.WriteLine "ICON = ""magnify.exe"" "
	fhta.WriteLine "BORDER=""THIN"" "
	fhta.WriteLine "INNERBORDER=""NO"" "
	fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
	fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
	fhta.WriteLine "SCROLL=""NO"" "
	fhta.WriteLine "SYSMENU=""NO"" "
	fhta.WriteLine "SELECTION=""NO"" "
	fhta.WriteLine "SINGLEINSTANCE=""YES"">"
	fhta.WriteLine "</HEAD>"
	fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
	fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
	fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
	fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
	fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
	fhta.WriteLine "Sub window_onload()"
	fhta.WriteLine "    CenterWindow 480,90"
	fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
	fhta.WriteLine " End Sub"
	fhta.WriteLine " Sub CenterWindow(x,y)"
	fhta.WriteLine "    Dim iLeft,itop"
	fhta.WriteLine "    window.resizeTo x,y"
	fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
	fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
	fhta.WriteLine "    window.moveTo ileft,itop"
	fhta.WriteLine "End Sub"
	fhta.WriteLine "</script>"
	fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
	Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
	oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
	Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top