Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A simple visual basic script which takes a file (identified by it's filename) through a prompt, parses it for online links (separated by return characters) and downloads it.
Function ReplaceRegEx(origString,replaceString,replaceWith)
Set TempRegEx=New RegExp
TempRegEx.Pattern=replaceString
TempRegEx.IgnoreCase=True
ReplaceRegEx = TempRegEx.Replace(origString,replaceWith)
End Function
msgbox "Link Batch Downloader. Copyright (c) eXtraMaster, Andy Tran 2012, First Major scripting project in about a month..."
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
UserInput = InputBox("Where is the file containing the list of links named? (Must be in the same directory as this file)")
If UserInput = "" Then
msgbox "No Filename Entered"
Else
If objFSO.FileExists(currentDirectory & UserInput) Then
msgbox "File Entered"
ForReading = UserInput
Set objFile = objFSO.OpenTextFile(currentDirectory & UserInput,1)
i = 0
Do Until objFile.AtEndOfStream
strNextLine = objFile.Readline
If strNextLine <> "" Then
objDictionary.Add i, strNextLine
End If
i = i + 1
Loop
objFile.Close
msgbox "File has been read"
msgbox "Now Downloading.... (might take a while)"
currentDirectory=Mid(currentDirectory,1,Len(currentDirectory)-1)
For Each strLine in objDictionary.Items
Set objFSO = CreateObject("Scripting.FileSystemObject")
linkNameSplit=Split(strLine,"/")
linkNameNumber=UBound(linkNameSplit)
linkNameTemp=""
For i = 3 To linkNameNumber-1
linkNameTemp=linkNameTemp&"\"&linkNameSplit(i)
newfolderpath=currentDirectory & linkNameTemp
If Not objFSO.FolderExists(newfolderpath) Then
objFSO.CreateFolder(newfolderpath)
End If
Next
strFileURL = strLine
strHDLocation = currentDirectory & linkNameTemp &"\"& linkNameSplit(linkNameNumber)
msgbox "Downloading file from: " & strFileURL & vbCrLf & "Placing file at: " & strHDLocation
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End if
Set objXMLHTTP = Nothing
Next
msgbox "Download of Files Completed!"
Else
msgbox "File Does not Exist!"
End if
End if
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment