VBS script to copy files and folders across network - file

I needed to copy all of my photos from my old laptop to my new laptop. This is a quick and dirty script that I put together (based on other scripts on this site) to copy files from one network location to another. I wanted the process to be able to recover in case of a network copy error because the total time to copy all of my photos was 40 hours.
sourceRoot and targetRoot is the beginning part of the file path to replace between locations. lastFileLog is a file used to keep track of the last file that was copied. This is needed to recover from a partial copy. Windows seems to allocate the full file size even when the file fails to copy. So I just keep track of the last file to copy it again on failure. objStartFolder is the starting path on the source network location.
'initialize paths
objStartFolder = "\\owner-pc\d\pics"
lastFileLog = "c:\Files\misc\archive.log"
sourceRoot = "\\owner-pc\d"
targetRoot = "c:\Files"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'read log
Set objFile = objFSO.OpenTextFile(lastFileLog)
Do Until objFile.AtEndOfStream
replacefile= objFile.ReadLine
Wscript.Echo "This file will be replaced: " & replacefile
Loop
objFile.Close
'copy files
Set objFolder = objFSO.GetFolder(objStartFolder)
ShowSubfolders objFSO.GetFolder(objStartFolder)
'clear log
Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
objFileLog.Write ""
objFileLog.Close
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Wscript.Echo Subfolder.Path
if not(objFSO.FolderExists(replace(Subfolder.Path,sourceRoot,targetRoot))) then
objFSO.CreateFolder(replace(Subfolder.Path,sourceRoot,targetRoot))
end if
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
if not(objFSO.FileExists(replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot))) then
Wscript.Echo Subfolder.Path & "\" & objFile.Name
Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
objFileLog.Write Subfolder.Path & "\" & objFile.Name
objFileLog.Close
objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot)
elseif replacefile = Subfolder.Path & "\" & objFile.Name then
Wscript.Echo "Replacing ... " & Subfolder.Path & "\" & objFile.Name
objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot),true
else
Wscript.Echo "Skip ... " & Subfolder.Path & "\" & objFile.Name
end if
Next
ShowSubFolders Subfolder
Next
end sub

For Folder: Try This.
Option Explicit
Dim obj,Itemcoll1,a,b
Set obj=CreateObject("Shell.Application")
Function SelectFold1(Desc)
Set SelectFold1=obj.BrowseForFolder(0,Desc,0,"C:\Users\Mohammed Sajjad\Desktop\")
End Function
Set Itemcoll1=SelectFold1("Copy: ").Items
SelectFold1("Paste: ").CopyHere Itemcoll1 'Use MoveHere if you want to move
MsgBox "Completed"
For File:
Option Explicit
Dim objApp : Set objApp = CreateObject("Shell.Application")
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSHL : Set objSHL = CreateObject("WScript.Shell")
'Browse for Folder
'----------------------------------------------------------
Function SelectFold()
Dim objFolder
Set objFolder = objApp.BrowseForFolder(0,"Select a Folder",0,0)
If objFolder Is Nothing Then
MsgBox "Canceled"
WScript.Quit
Else
SelectFold = objFolder.Self.Path & "\"
End If
End Function
'----------------------------------------------------------
'Browse for file
'----------------------------------------------------------
Function SelectFile()
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempFile : tempFile = objFSO.GetTempName() & ".hta"
Dim path : path = "HKCU\Volatile Environment\MsgResp"
With tempFolder.CreateTextFile(tempFile)
.Write "<input type=file name=f>" & _
"<script>f.click();(new ActiveXObject('WScript.Shell'))" & _
".RegWrite('HKCU\\Volatile Environment\\MsgResp', f.value);" & _
"close();</script>"
.Close
End With
objSHL.Run tempFolder & "\" & tempFile, 0, True
If objSHL.RegRead(path) = "" Then
objSHL.RegDelete path
objFSO.DeleteFile tempFolder & "\" & tempFile
WScript.Quit
End If
SelectFile = objSHL.RegRead(path)
objSHL.RegDelete path
objFSO.DeleteFile tempFolder & "\" & tempFile
End Function
'----------------------------------------------------------
objFSO.CopyFile SelectFile, SelectFold

Related

batch or vb script to read URL from excel file and download URL attached file to specified location or directory

I am looking for a VB script or batch file to read & Execute multiple URLs from an CSV file containing the URL Data in column B & The mentioned URL directly contains on the downloadable file which need to store at location or directory named on behalf of content stored in Column A.
Column A & Column B could be vice versa.
I was trying same thing with batch file but unable to read CSV file automatically instead able to create simple code as show below but would be no success for daily usage as automatic as always required manual intervention, please help accordingly, also check in Python solution code is available but do not want to use it as required Python installation as do not want to do so too.
#echo Off
TITLE Test File Download and Storage
Pause
CD\
d:
cd Test
dir Tes_poc1 [i.e. From column A]
curl http://www.abcd,com/file1.pdf > file1.pdf [URL Just for example, can't share actual one due to security limitations]
cd Test
dir Tes_poc2 "i.e. From column A"
curl http://www.abcd,com/file2.pdf > file2.pdf [URL Just for example, can't share actual one due to security limitations]
Edit :
Also tried following VBscript able to download file and create folder but unable to move downloaded file to respective folder:
dim objFileSys, objReadFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const csFSpec = "1.txt"
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim goWS : Set goWS = CreateObject("WScript.Shell")
Dim tsIn : Set tsIn = goFS.OpenTextFile(csFSpec)
Do Until tsIn.AtEndOfStream
Dim sLine : sLine = tsIn.ReadLine
goWS.Run """chrome.exe"" """ & sLine & """", 1, True
Loop
tsIn.Close
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objReadFile = objFileSys.OpenTextFile("D:\Test\2.txt", ForReading)
Do until objReadFile.AtEndOfStream = True
objFileSys.CreateFolder(objReadFile.ReadLine)
Loop
objReadFile.Close
Set objReadFile = Nothing
Set objFileSys = Nothing
Where 1.txt contains list of urls and 2.txt contains list of respective URL folder name to be create
here are few Example URL's you can use as sample.
http://www.iiswc.org/iiswc2009/sample.doc
https://www.scc.kit.edu/downloads/jrg-mb/Abstract_template.doc
https://www.k-state.edu/grad/etdr/template/mastersinstructions.doc
https://www.cdc.gov/polio/stop/doc/stop-cv-format.doc
Suppose you have the contents of the.csv file like this one in the same folder of your batch file : Test.csv
Tes_poc1,http://www.pdf995.com/samples/pdf.pdf
Tes_poc2,https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png
You can do something like this to download files with Certutil command line :
#echo off
Mode 60,3 & Color A
Title Download files with Certutil command by Hackoo 2018
Set "File=%~dp0Test.csv"
Set "DownloadFolder=%~dp0Test"
if not exist "%DownloadFolder%" MD "%DownloadFolder%"
CD /D "%DownloadFolder%"
#for /F "tokens=1-2 delims=," %%i in ('Type "%File%"') do (
If not exist "%DownloadFolder%\%%i\" MD "%DownloadFolder%\%%i\"
cls & echo( & echo Downloading "%%~nxj"
Call :Download %%j %DownloadFolder%\%%i\%%~nxj
)
Start "" Explorer "%DownloadFolder%" & Exit
::--------------------------------------------
:Download <Url> <File>
certutil.exe -urlcache -split -f %1 %2 >nul
exit /b
::-------------------------------------------
You can give a try for this vbscript with a progressbar in bonus !
Usage : Drag and Drop a text file that contains url per row over this script to be downloaded
Or
Usage in command line : Cscript //nologo "ThisVbsFile" "Path\TextFile.txt"
Option Explicit
Const Copyright =" (C) by Hackoo 2018"
Dim Title,InputFile,objFSO,objStream,dic,URL,FileName,PathScript
Dim BaseName,Save2File,Folder,k,WaitingMsg,ws,Temp,oExec,HH
Title = "Download From File"
If WSH.Arguments.Count = 0 Then
MsgBox "Usage : Drag and Drop a text file that contains url per row over " &_
"this script "& DblQuote(WSH.Scriptname) & " to be downloaded "& vbCrlf &_
"OR " & vbCrlf &_
"Usage in command line : "& vbCrlf &_
"Cscript //nologo "& DblQuote(WSH.Scriptname) & " " & DblQuote("Path\TextFile.txt"),_
vbExclamation,Title & Copyright
Wscript.Quit(1)
End If
InputFile = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objStream = objFSO.OpenTextFile (InputFile, 1)
set dic = CreateObject("Scripting.Dictionary")
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Do while not objStream.AtEndOfStream
URL = objStream.ReadLine
If URL <> "" Then
FileName = GetFileNamefromDirectLink(URL)
PathScript = objFSO.GetParentFolderName(wscript.ScriptFullName) 'Path of this Vbscript
BaseName = GetFilenameWithoutExtension(FileName)
Folder = PathScript & "\" & BaseName
If Not objFSO.FolderExists(Folder) Then
objFSO.CreateFolder(Folder)
End If
dic.Add URL,Folder & "\" & FileName
End If
Loop
For Each URL in dic
Save2File = dic(URL)
WaitingMsg = "Please wait ... The download of : <font color=Yellow>"& DblQuote(Save2File) & "</font> is in progress ..."
Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
Call LaunchProgressBar() 'Launch of the Waiting Bar
Call Download(URL,Save2File)
pause(1)
Call CloseProgressBar()
Next
Set HH = CreateObject("Internet.HHCtrl")
HH.TextPopup " Download is finished ! ", "Tahoma,32", 10,10,10,500
Pause(3)
Wscript.Quit(0)
'------------------------------------------------
Sub Download(URL,Save2File)
Dim File,Line,BS,ws
On Error Resume Next
Set File = CreateObject("WinHttp.WinHttpRequest.5.1")
File.Open "GET",URL, False
File.Send()
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then ' File exists and it is ready to be downloaded
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
ElseIf File.Status = 404 Then
MsgBox "File Not found : " & File.Status,vbCritical,"Error File Not Found"
Else
MsgBox "Unknown Error : " & File.Status,vbCritical,"Error getting file"
End If
End Sub
'------------------------------------------------
Function GetFileNamefromDirectLink(URL)
Dim ArrFile,FileName
ArrFile = Split(URL,"/")
FileName = ArrFile(UBound(ArrFile))
GetFileNamefromDirectLink = FileName
End Function
'------------------------------------------------
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'------------------------------------------------
Function GetFilenameWithoutExtension(FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFilenameWithoutExtension = Result
End Function
'------------------------------------------------
Sub CreateProgressBar(Title,WaitingMsg)
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> " & Title & Copyright & "</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>"
fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>"
fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
fhta.WriteLine "</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 575,100"
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 LaunchProgressBar()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'------------------------------------------------
Sub CloseProgressBar()
oExec.Terminate
End Sub
'------------------------------------------------
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'------------------------------------------------
Sub Pause(Secs)
Wscript.Sleep(Secs * 1000)
End Sub
'------------------------------------------------

Update Access front end through batch file?

Looking to see if there would be a way for users to update their MS Access db front end by clicking a button. The button would then trigger a batch file that would grab the file from a location on our server, and overwrite the current db on the users local PC. All done within one office, so network addresses would be all the same.
Location of file to copy: 10.0.0.0.5/Data/DB/Database.accdb
Location of file to overwrite: c:\DB\Database.accdb
Any ideas? Ideally I would love for someone to write a nice exe file that deletes the older version and installs the newer version, but can't write that kind of code.
Write a batch file to retrieve the newer version of the front end from it's source and copy it into the folder where the user's copy of the front end file lives. Add a line at the end of the batch file to launch msacess.exe with the filename of your front end program as a command line parameter.
The batch file can be located anywhere, but I recommend locating it in the folder where your application front end will reside.
Create a Windows shortcut to the batch file, which can be placed on the users' Desktop or anywhere else the user expects to launch the application.
Bonus points for dressing up the shortcut to the batch file by changing the icon: Right-click|Properties|Change icon... button.
A nice article on the topic can be found here:
Deploy and update a Microsoft Access application in a Citrix environment
It uses neither a bat, nor an exe, but a VBscript:
Option Explicit
' Launch script for PPT test/development/operation.
' Version 1.3.0
' 2013-09-15
' Cactus Data. Gustav Brock
Const DESKTOP = &H10
Const LOCALAPPDATA = &H1C
Dim objFSO
Dim objAppShell
Dim objDesktopFolder
Dim objLocalAppDataFolder
Dim objLocalFolder
Dim objRemoteFolder
Dim strLocalFolder
Dim strRemoteFolder
Dim strDesktopFolder
Dim strLocalAppDataFolder
Dim strLocalAppDataDsgFolder
Dim strLocalAppDataDsgPptFolder
Dim strDsgSubfolder
Dim strPptSubfolder
Dim strPptAppSubfolder
Dim strPptNcSuffix
Dim strAppName
Dim strAppSuffix
Dim strShortcutName
Dim strAppLocalPath
Dim strAppLocalBackPath
Dim strAppRemotePath
Dim strShortcutLocalPath
Dim strShortcutRemotePath
Dim strRegPath
Dim strRegKey
Dim strRegValue
Dim booNoColour
Dim varValue
' Adjustable parameters.
strDsgSubfolder = "DSG"
strPptSubfolder = "PPT"
strPPtNcSuffix = "NC"
' ---------------------------------------------------------------------------------
' Uncomment one folder name only:
'strPptAppSubfolder = "Development"
strPptAppSubfolder = "Operations"
'strPptAppSubfolder = "Test"
' ---------------------------------
' Indicate if the script is for the normal version (0) or the no-colour version (1):
booNoColour = 0
' ---------------------------------------------------------------------------------
strRemoteFolder = "K:\_Shared\Sales Planning\Environments\" & strPptAppSubfolder
If booNoColour = 1 Then
strAppSuffix = strPptNcSuffix
Else
strAppSuffix = ""
End If
strAppName = "SalesPlanningTool" & strAppSuffix & ".accdb"
If strPptAppSubfolder = "Operations" Then
If strAppSuffix = "" Then
strShortcutName = "RunPPT.lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & ".lnk"
End If
Else
If strAppSuffix = "" Then
strShortcutName = "RunPPT " & strPptAppSubfolder & ".lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & " " & strPptAppSubfolder & ".lnk"
End If
End If
' Enable simple error handling.
On Error Resume Next
' Find user's Desktop and AppData\Local folder.
Set objAppShell = CreateObject("Shell.Application")
Set objDesktopFolder = objAppShell.Namespace(DESKTOP)
strDesktopFolder = objDesktopFolder.Self.Path
Set objLocalAppDataFolder = objAppShell.Namespace(LOCALAPPDATA)
strLocalAppDataFolder = objLocalAppDataFolder.Self.Path
' Dynamic parameters.
strLocalAppDataDsgFolder = strLocalAppDataFolder & "\" & strDsgSubfolder
strLocalAppDataDsgPptFolder = strLocalAppDataDsgFolder & "\" & strPptSubfolder
strLocalFolder = strLocalAppDataDsgPptFolder & "\" & strPptAppSubfolder
strAppLocalPath = strLocalFolder & "\" & strAppName
strShortcutLocalPath = strDesktopFolder & "\" & strShortcutName
' Permanent parameters.
strAppRemotePath = strRemoteFolder & "\" & strAppName
strShortcutRemotePath = strRemoteFolder & "\" & strShortcutName
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strRemoteFolder) Then
Call ErrorHandler("No access to " & strRemoteFolder & ".")
Else
Set objRemoteFolder = objFSO.GetFolder(strRemoteFolder)
' If local folder does not exist, create the folder.
If Not objFSO.FolderExists(strLocalFolder) Then
If Not objFSO.FolderExists(strLocalAppDataDsgFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalAppDataDsgPPtFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgPptFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgPptFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalFolder & " could not be created.")
End If
End If
End If
Set objLocalFolder = objFSO.GetFolder(strLocalFolder)
End If
If Not objFSO.FileExists(strAppRemotePath) Then
Call ErrorHandler("The application file:" & vbCrLf & strAppRemotePath & vbCrLF & "could not be found.")
Else
' Close a running PPT.
Call KillTask("PPT")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
Call KillTask("PPT Background")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
' Copy app to local folder.
If objFSO.FileExists(strAppLocalPath) Then
objFSO.DeleteFile(strAppLocalPath)
If Not Err.Number = 0 Then
Call ErrorHandler("The application file:" & vbCrLf & strAppName & vbCrLF & "can not be refreshed/updated. It may be in use.")
End If
End If
If objFSO.FileExists(strAppLocalPath) Then
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be replaced.")
Else
objFSO.CopyFile strAppRemotePath, strAppLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Application could not be copied to " & strLocalFolder & ".")
End If
' Create copy for PPT Background.
strAppLocalBackPath = Replace(Replace(strAppLocalPath, ".accdb", ".accbg"), "SalesPlanningTool", "SalesPlanningToolBack")
objFSO.CopyFile strAppLocalPath, strAppLocalBackPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Background application could not be copied to " & strLocalFolder & ".")
End If
End If
' Copy shortcut.
objFSO.CopyFile strShortcutRemotePath, strShortcutLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Shortcut could not be copied to your Desktop.")
End If
End If
' Write Registry entries for Access security.
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\"
strRegValue = "VBAWarnings"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue,"REG_DWORD")
strRegKey = strRegKey & "Trusted Locations\LocationLocalAppData\"
strRegValue = "AllowSubfolders"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue, "REG_DWORD")
strRegValue = "Date"
strRegPath = strRegKey & strRegValue
varValue = Now
varValue = FormatDateTime(varValue, vbShortDate) & " " & FormatDateTime(varValue, vbShortTime)
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Description"
strRegPath = strRegKey & strRegValue
varValue = "Local AppData"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Path"
strRegPath = strRegKey & strRegValue
varValue = strLocalAppDataFolder & "\"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
' Run PPT.
If objFSO.FileExists(strAppLocalPath) Then
Call RunApp(strAppLocalPath, False)
Else
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be found.")
End If
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Quit
' Supporting subfunctions
' -----------------------
Sub RunApp(ByVal strFile, ByVal booBackground)
Dim objShell
Dim intWindowStyle
' Open as default foreground application.
intWindowStyle = 1
Set objShell = CreateObject("WScript.Shell")
objShell.Run Chr(34) & strFile & Chr(34), intWindowStyle, False
Set objShell = Nothing
End Sub
Sub KillTask(ByVal strWindowTitle)
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "TaskKill.exe /FI ""WINDOWTITLE eq " & strWindowTitle & """", 7, False
Set objShell = Nothing
End Sub
Sub AwaitProcess(ByVal strProcess)
Dim objSvc
Dim strQuery
Dim colProcess
Dim intCount
Set objSvc = GetObject("winmgmts:root\cimv2")
strQuery = "select * from win32_process where name='" & strProcess & "'"
Do
Set colProcess = objSvc.Execquery(strQuery)
intCount = colProcess.Count
If intCount > 0 Then
WScript.Sleep 300
End If
Loop Until intCount = 0
Set colProcess = Nothing
Set objSvc = Nothing
End Sub
Sub WriteRegistry(ByVal strRegPath, ByVal varValue, ByVal strRegType)
' strRegType should be:
' "REG_SZ" for a string
' "REG_DWORD" for an integer
' "REG_BINARY" for a binary or boolean
' "REG_EXPAND_SZ" for an expandable string
Dim objShell
Set objShell = CreateObject("WScript.Shell")
Call objShell.RegWrite(strRegPath, varValue, strRegType)
Set objShell = Nothing
End Sub
Sub ErrorHandler(Byval strMessage)
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Echo strMessage
WScript.Quit
End Sub
You could probably convert it to PowerShell, which I would use today.
I use a vbscript for that purpose. I only update the path for the file due to be copied and then I sent an email to the users with a link to the script. The user clicks the link and the script is executed.
Copy the code below to a text file and save it as .vbs. Don't forget to set the path for the file due to be copied.
Option Explicit
Call Main()
Private Sub Main()
const folderFrom = "\\Somepath\Somefolder\" 'Folder: Must supply backslash
const fileName = "SomeFile.accdb" 'File name with extension
const overwrite = -1 'OverWrite = True
'Ask user to proceed
dim msg
msg = "The script will copy the file below to your desktop. " & vbNewLine & vbNewLine & _
String(75,"_") & vbNewLine & vbNewLine & _
"File: " & " " & " " & " " & " " & " " & " " & " '" & fileName & "' " & vbNewLine & _
"Folder: " & " " & " '" & folderFrom & "' " & vbNewLine & _
String(75,"_") & vbNewLine & vbNewLine & _
"Proceed?"
if MsgBox(msg, vbYesNo + vbQuestion, "FileCopy Confirmation") = vbNo then exit sub
on error resume next
dim filesys
set filesys = CreateObject("Scripting.FileSystemObject")
'File exists in folder?
if not filesys.FileExists(folderFrom & fileName) then
MsgBox "File not found. Task aborted. ", vbOKOnly + vbExclamation, "Attention:"
exit sub
end if
'User's desktop path
dim desktopPath
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
'Copy file
filesys.CopyFile folderFrom & fileName, desktopPath & fileName, overwrite
'Validate file copied
if filesys.FileExists(desktopPath & fileName) then
Msgbox "File copied successfully.", vbOKOnly + vbInformation, "Success!"
else
MsgBox "File could not be copied... ", vbOKOnly + vbExclamation, "Copy Failed..."
end if
End Sub
Suggestion:
You shouldn't overwrite the existing front-end database but instead you should consider versioning e.g. v2.0, v2.1, v2.2 etc. for better tracking.

VBscript WMI doesn't locate files, FSO does

I have two files weblogic.jar and weblogic.policy in C:\Weblogic\wlserver\server\lib. With the first method, the script finds them and displays the name of the file:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Weblogic\wlserver\server\lib")
Set colFiles = objFolder.Files
For Each objFile in colFiles
If(StrComp(objFile.Name, "weblogic.jar", 1) = 0 OR StrComp(objFile.Name, "weblogic.policy", 1) = 0) Then
Wscript.Echo objFile.Name, objFile.Size
End If
Next
When I try to use WMI with CIM_DataFile, the script doesn't find any file in the same folder (but finds some in other folders):
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colFiles = objWMIService.ExecQuery ("Select Name from CIM_DataFile where FileName = 'weblogic'",, 48)
For Each objFile in colFiles
Wscript.Echo objFile.Name
Next
I am on Windows Server 2012 R2, I run the script as administrator and the folder C:\Weblogic needs admin privileges.
Is it a WMI privilege problem?
Someone already have this problem? What is the solution?
EDIT:
Thanks for your answer.
Sadly, that doesn't work. I get the same result.
I run the 2 method on the same script. I try to create test files on my desktop named weblogic.jar, weblogic.policy, ... and WMI doesn't find them !
Maybe WMI no longer works properly on this server ?
This is my script:
If Not WScript.Arguments.Named.Exists("elevate") Then
Wscript.Echo "Run"
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, WScript.ScriptFullName & " /elevate", "", "runas", 1
WScript.Quit
End If
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile="C:\test.txt"
Set objFileLog = objFSO.CreateTextFile(outFile,True)
objFileLog.Write "Scripting.FileSystemObject :" & vbCrLf
Set objFolder = objFSO.GetFolder("C:\Weblogic\wlserver\server\lib")
Set colFiles = objFolder.Files
For Each objFile in colFiles
If(StrComp(objFile.Name, "weblogic.jar", 1) = 0 OR StrComp(objFile.Name, "weblogic.policy", 1) = 0) Then
Wscript.Echo objFile.Name, objFile.Size
objFileLog.Write " " & objFile.Path & " " & objFile.Size & vbCrLf
End If
Next
objFileLog.Write "winmgmts :" & vbCrLf
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colFiles = objWMIService.ExecQuery ("Select Name from CIM_DataFile where FileName = 'weblogic'",, 48)
For Each objFile in colFiles
Wscript.Echo objFile.Name
objFileLog.Write " " & objFile.Name & vbCrLf
Next
objFileLog.Close
And the result is:
Scripting.FileSystemObject :
C:\Weblogic\wlserver\server\lib\weblogic.jar 5541
C:\Weblogic\wlserver\server\lib\weblogic.policy 30888
winmgmts :
c:\oracle\...\templates\wlserver\server\lib\weblogic.policy
c:\oracle\...\wlserver\server\lib\weblogic.policy
c:\oracle\...\sample\config\wls\web-inf\weblogic.xml
I don't get weblogic files with WMI in folders :
"C:\Weblogic\wlserver\server\lib\"
"C:...\Desktop\"
Try something like this to run the script with admin privileges :
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, WScript.ScriptFullName & " /elevate", "", "runas", 1
WScript.Quit
End If
'Your code goes here

VBScript to send a link to file AND folder

In Windows 7, I've got a VBScript that creates an email in Outlook with a link to the file when you right-click in Windows Explorer. The script is run by creating a shortcut to it and adding it to %userprofile%\SendTo (which shows up in the Send to when you right-click the file). The goal is to be able to send a link to the file and the folder that contains it, rather than sending it as an attachment. It works fine except it always give a link directly to the file. How do I modify it so it also provides a link to the folder in the second line?
Const olMailItem = 0
Const olFolderInbox = 6
If WScript.Arguments.Count = 0 Then
WScript.Quit
End If
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_Process Where Name = 'outlook.exe'")
If colItems.Count = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
objFolder.Display
End If
strFile = WScript.Arguments.Item(0)
Set objOutlook = CreateObject("Outlook.Application")
Set objItem = objOutlook.CreateItem(olMailItem)
objItem.Subject = "Here is a link to a file..."
objItem.HTMLBody = "Link to the file: " & strFile & "<BR>Link to the folder: " & strFile & ""
objItem.Display
Might be a simple answer, but I haven't been able to figure it out. Any help would be appreciated!
The FileSystemObject object and it's GetParentFolderName method could help. Note that for any of methods used (in next script) hold: a method works only on the provided path string. It does not attempt to resolve the path, nor does it check for the existence of the specified path.
option explicit
Dim strFile, FSO, oFile
If WScript.Arguments.Count > 0 Then
strFile = WScript.Arguments.Item(0)
Else
strFile = "D:\Remote\bat\COCL\bu bu bu\somefile.ext"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Wscript.Echo "FSO 'path' methods" & vbNewLine & "---------------------" _
& vbNewLine & "GetAbsolutePathName: " & FSO.GetAbsolutePathName( strFile) _
& vbNewLine & "GetParentFolderName: " & FSO.GetParentFolderName( strFile) _
& vbNewLine & "GetDriveName: " & FSO.GetDriveName( strFile) _
& vbNewLine & "GetBaseName: " & FSO.GetBaseName( strFile) _
& vbNewLine & "GetExtensionName: " & FSO.GetExtensionName( strFile) _
& vbNewLine & "GetFileName: " & FSO.GetFileName( strFile)
Set FSO = Nothing
Wscript.Quit

How to run a file in vbscript within the code given below?

Here's the code that I found which matches my criteria. The code below is used to copy file from source path to target path.
Conditions implied:
Only if the file doesn't exist on the target path or if the file exists but its older then the source path and the target file is overwritten.
How do I run a target file within this code so that the target file runs only when the file is being overwritten or the target file is freshly copied?
Option Explicit
Dim WshShell
Dim fso
Dim USERPROFILE
Dim srcPath
Dim tgtPath
On Error Resume Next
Set WshShell = WScript.CreateObject("Wscript.Shell")
Set fso = WScript.CreateObject("Scripting.FilesystemObject")
'USERPROFILE = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
srcPath = "C:\test.exe"
tgtPath = "D:\"
If Not fso.FileExists(tgtPath) Then
fso.CopyFile srcPath, tgtPath, True
ElseIf fso.FileExists(srcPath) Then
ReplaceIfNewer srcPath, tgtPath
End If
Sub ReplaceIfNewer(strSourceFile, strTargetFile)
Const OVERWRITE_EXISTING = True
Dim objFso
Dim objTargetFile
Dim dtmTargetDate
Dim objSourceFile
Dim dtmSourceDate
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Set objTargetFile = objFso.GetFile(strTargetFile)
dtmTargetDate = objTargetFile.DateLastModified
Set objSourceFile = objFso.GetFile(strSourceFile)
dtmSourceDate = objSourceFile.DateLastModified
If (dtmTargetDate < dtmSourceDate) Then
objFso.CopyFile objSourceFile.Path, objTargetFile.Path,OVERWRITE_EXISTING
End If
Set objFso = Nothing
End Sub
Here a reworded and working vesion of your script
option explicit
dim WshShell, fso, srcPath, tgtPath , file, objFileSrc, objFileTgt
const OVERWRITE = true
set WshShell = WScript.CreateObject("Wscript.Shell")
set fso = WScript.CreateObject("Scripting.FilesystemObject")
file = "test.exe"
srcPath = "c:\"
tgtPath = "e:\"
if fso.FileExists(srcPath & file) then
if not fso.FileExists(tgtPath & file) then
'target doesn't exist, just copy
fso.CopyFile srcPath & file, tgtPath
wscript.echo srcPath & file & " copied to " & tgtPath & file
else
Set objFileSrc = fso.getFile(srcPath & file)
Set objFileTgt = fso.getFile(tgtPath & file)
'target exists, compare dates
if objFileSrc.DateLastModified > objFileTgt.DateLastModified then
fso.CopyFile srcPath & file, tgtPath, OVERWRITE
wscript.echo srcPath & file & " copied over " & tgtPath & file
else
wscript.echo srcPath & file & " not newer then " & tgtPath & file
end if
end if
else
wscript.echo srcPath & file & " does not exist"
end if
set fso = Nothing

Resources