- Bohack - https://www.bohack.com -

How To Save A Webpage In HTML To A File In VBScript

I had just finished working on a project where I needed to programmatically get a web page and save the HTML to a file. I started toying around with some code I used for parsing XML and totally rewrote the code. I found that I kept getting an error of “Microsoft VBScript runtime error: Invalid procedure call or argument”. I couldn’t understand what was going on. I was passing the parameters correctly to the File System Object, but I kept getting the error. All FSO was doing was creating a file and writing the string out. So I checked the length and then started writing the left(string,number) and found it was a character that was in Unicode. So I wrote a Unicode to Ascii function that is not all that efficient, but it is very effective. The sample code below will get a webpage from Google and save it to a file.

You can modify the code to accept arguments and make a VBScript replacement for wget the UNIX command. However wget is much more versatile and allows for a lot more features like agent string and referrer string modification. I use the “msxml2.xmlhttp.6.0” object, but you can replace it with “msxml2.xmlhttp.3.0” if you run into a problem. I had tested it on XP and Vista, so I think the “msxml2.xmlhttp.6.0” is tied to the IE version of IE version 6. Maybe someone can clarify that. The code does work and enjoy.

Dim FSO, dFile, sHTML

sHTML = Get_HTML ("http://www.google.com")

Set FSO = CreateObject("Scripting.FileSystemObject")
Set dFile = FSO.CreateTextFile("SaveFile.html", True)

dFile.Write UniToAsc(sHTML)
dFile.Close

Set dFile = Nothing
Set FSO = Nothing

Private Function Get_HTML (up_http)
 Dim xmlhttp
 Set xmlhttp = createobject("msxml2.xmlhttp.6.0")

 xmlhttp.open "get", up_http, False
 xmlhttp.send
 Get_HTML = xmlhttp.responsetext

 set xmlhttp = Nothing
End Function

Private Function UniToAsc(sString)
 Dim nLen, nPTR, sAsc
 nLen = Len(sString)

 For nPTR = 1 To nLen
  sAsc = sAsc & Chr(Asc(Mid(sString, nPTR, 1)))
 Next

 UniToAsc = sAsc
End Function