2010-06-04 8 views
15

J'ai un script VBS qui génère une URL pour télécharger un fichier à partir d'un serveur sur mon réseau. Je dois maintenant télécharger le fichier à "C: \ rWallpaper \ wallpaper.png", l'URL est stockée dans la variable "url"Télécharger un fichier avec VBS

Id comme pour travailler quelque chose comme wget sur Linux, il suffit de télécharger et enregistrer le fichier à un endroit spécifié.

Répondre

29

Vous pouvez télécharger en utilisant XMLHTTP et exploiter un flux ADO pour écrire les données binaires;

dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP") 
dim bStrm: Set bStrm = createobject("Adodb.Stream") 
xHttp.Open "GET", "http://bla.com/xxx.png", False 
xHttp.Send 

with bStrm 
    .type = 1 '//binary 
    .open 
    .write xHttp.responseBody 
    .savetofile "c:\temp\xxx.png", 2 '//overwrite 
end with 
+0

Cela fonctionne et m'a beaucoup aidé, mais vous devez spécifier le nom de la cible. Le problème est si vous voulez utiliser le nom de fichier original qui a été suggéré par le serveur. – Racky

+7

@Racky après '.send' (si le serveur le juge nécessaire) le nom de fichier suggéré est après le jeton' filename = 'disponible via' hdr = xHttp.getResponseHeader ("Content-Disposition") ' –

6

La réponse ci-dessus a jeté l'erreur Write to file failed. Code: 800A0BBC pour moi, mais cela a fonctionné:

HTTPDownload http://www.emagcloud.com/europeansealing/FSA_ESA_Compression_Packing_Technical_Manual_v3/pubData/source/images/pages/page10.jpg", "C:\" 

Sub HTTPDownload(myURL, myPath) 
' This Sub downloads the FILE specified in myURL to the path specified in myPath. 
' 
' myURL must always end with a file name 
' myPath may be a directory or a file name; in either case the directory must exist 
' 
' Written by Rob van der Woude 
' http://www.robvanderwoude.com 
' 
' Based on a script found on the Thai Visa forum 
' http://www.thaivisa.com/forum/index.php?showtopic=21832 

    ' Standard housekeeping 
    Dim i, objFile, objFSO, objHTTP, strFile, strMsg 
    Const ForReading = 1, ForWriting = 2, ForAppending = 8 

    ' Create a File System Object 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 

    ' Check if the specified target file or folder exists, 
    ' and build the fully qualified path of the target file 
    If objFSO.FolderExists(myPath) Then 
     strFile = objFSO.BuildPath(myPath, Mid(myURL, InStrRev(myURL, "/") + 1)) 
    ElseIf objFSO.FolderExists(Left(myPath, InStrRev(myPath, "\") - 1)) Then 
     strFile = myPath 
    Else 
     WScript.Echo "ERROR: Target folder not found." 
     Exit Sub 
    End If 

    ' Create or open the target file 
    Set objFile = objFSO.OpenTextFile(strFile, ForWriting, True) 

    ' Create an HTTP object 
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") 

    ' Download the specified URL 
    objHTTP.Open "GET", myURL, False 
    objHTTP.Send 

    ' Write the downloaded byte stream to the target file 
    For i = 1 To LenB(objHTTP.ResponseBody) 
     objFile.Write Chr(AscB(MidB(objHTTP.ResponseBody, i, 1))) 
    Next 

    ' Close the target file 
    objFile.Close() 
End Sub 

+0

Si la réponse acceptée échoué avec cette erreur spécifique, le problème est d'autorisations d'écrire dans le dossier, ce qui n'est pas difficile à résoudre. – Lankymart

+1

Vous avez raison, et je l'ai résolu en utilisant le code fourni. –

+1

Votre méthode est très lente lorsque la taille du fichier est grande (par exemple un pdf 400k, j'ai utilisé 20 secondes pour télécharger) la réponse marquée qui utilise seulement 2 secondes pour télécharger le même fichier. –

0

Ce message est ancien, mais l'erreur dans la réponse du code fisrt est que vous avez besoin de privilèges pour écrire en C :. Essayez au bureau ou% temp%, cela fonctionne.

3

En plus de répondre Alex K, j'ai utilisé ce qui suit si elle aide quelqu'un:

Définir l'objet

Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1") 

Appel lien de téléchargement avec un fichier (image dans notre cas)

URL = "https://www.grupya.com/public/assets/img/logo.png" 
objWinHttp.open "GET", URL, False 
objWinHttp.send "" 

Sauvegardez les données binaires sur le disque

SaveBinaryData "c:\temp\my.png",objWinHttp.responseBody 

SaveBinaryData Fonction

Function SaveBinaryData(FileName, Data) 

' adTypeText for binary = 1 
Const adTypeText = 1 
Const adSaveCreateOverWrite = 2 

' Create Stream object 
Dim BinaryStream 
Set BinaryStream = CreateObject("ADODB.Stream") 

' Specify stream type - we want To save Data/string data. 
BinaryStream.Type = adTypeText 

' Open the stream And write binary data To the object 
BinaryStream.Open 
BinaryStream.Write Data 

' Save binary data To disk 
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite 

End Function 
+0

Fonctionne comme un charme; Toda'a –

Questions connexes