批处理或 vb 脚本,用于从 excel 文件读取 URL 并将 URL 附加文件下载到指定位置或目录

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

提问人:mr.cooldeath 提问时间:6/28/2018 最后编辑:mr.cooldeath 更新时间:7/10/2018 访问量:1129

问:

我正在寻找一个 VB 脚本或批处理文件来读取和执行多个 URL,其中包含 B 列中的 URL 数据,并且提到的 URL 直接包含在可下载文件中,该文件需要存储在代表 A 列中存储的内容命名的位置或目录中。

A列和B列反之亦然。

我正在尝试使用批处理文件做同样的事情,但无法自动读取 CSV 文件,而是能够创建如下所示的简单代码,但对于日常使用来说不会成功,因为一如既往地自动需要手动干预,请相应地提供帮助,也检查 Python 解决方案代码可用,但不想根据需要使用它 Python 安装,因为也不想这样做。

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

编辑:

还尝试了以下VBscript能够下载文件并创建文件夹,但无法将下载的文件移动到相应的文件夹:

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

其中 1.txt 包含 URL 列表,2.txt 包含要创建的相应 URL 文件夹名称的列表

以下是一些示例URL,您可以将其用作示例。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

批处理文件 VBScript 下载 自动存储

评论

2赞 npocmaka 6/28/2018
这些下载行有效吗?从 excell 读取单元格值的简单方法是使用 powershell - stackoverflow.com/questions/16615364/...
1赞 6/28/2018
您应该提供一个示例 csv(如有必要,为匿名),否则它是一个猜谜游戏。 (包含在最新的 Win 10 更新中)有很多选项:curl.exe-o, --output <file> Write to file instead of stdout
0赞 Hackoo 7/1/2018
编辑您的问题,并为我们提供您的 csv 文件的示例结构!
0赞 mr.cooldeath 7/4/2018
Tes_poc1,pdf995.com/samples/pdf.pdf Tes_poc2,google.com/images/branding/googlelogo/1x/......“这是CSV类型的完美例子”

答:

2赞 Hackoo 7/3/2018 #1

假设您在批处理文件的同一文件夹中有像这样的 .csv 文件的内容: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

您可以执行如下操作以使用 Certutil 命令行下载文件:

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

评论

0赞 mr.cooldeath 7/4/2018
嗨,感谢您的帮助,但文件下载面临一些问题,我能够创建文件夹,但无法从相关 URL 下载任何文件,可能是我们在 URL 执行和文件夹创建中需要一些睡眠时间。此外,我无法在没有任何停顿的情况下执行完整的命令,例如总是要求“按任意键继续”。您提供的解决方案似乎比我的要好得多,在改进代码方面需要更多帮助,我也尝试过自己,但我对 certutil 的使用没有那么多经验。再次感谢您的大力帮助
0赞 mr.cooldeath 7/4/2018
还为引发的查询添加了一个 VB 脚本组合代码,能够同时下载文件和创建文件夹,但不能将每个下载的文件仅移动到相应的文件夹或默认下载到相应的文件夹。请检查我的问题,我在那里更新了同样的东西
0赞 Hackoo 7/4/2018
@mr.cooldeath没有内容,我们就无法取得任何进展?URL 以 OR NOT 结尾,我的意思是,你有直接链接吗?1.txt2.txt.pdf
0赞 mr.cooldeath 7/5/2018
更新了有问题的示例 URL,感谢您的支持
0赞 Hackoo 7/5/2018
@mr.cooldeath 和 2.txt ?它看起来如何?给我至少 4 行!
0赞 Hackoo 7/10/2018 #2

您可以尝试使用带有进度条的 vbscript 作为奖励!

用法:将包含每行 url 的文本文件拖放到要下载的脚本上

命令行用法: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  
'------------------------------------------------