Skip to content

Instantly share code, notes, and snippets.

@extramaster
Last active October 8, 2021 21:09
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save extramaster/5466306 to your computer and use it in GitHub Desktop.
Save extramaster/5466306 to your computer and use it in GitHub Desktop.
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