Public Sub download()
Call downloadbse1
Call downloadbsedelivery1
'Range("B3").Value = "mm/dd/yyyy"
'Range("C3").Value = "mm/dd/yyyy"
ActiveWorkbook.Save
End Sub
Public Sub downloadbse()
On Error Resume Next
MkDir ("E:\Macros\BseDailyBhav")
On Error Resume Next
Kill "E:\Macros\BseDailyBhav\*.csv*"
On Error Resume Next
Kill "E:\Macros\Input\BseDailyBhav\*.zip*"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'get start date and range===============================
Range("A1").Select
Dim daycount, daycountend, startday, startmonth, startyear As Variant
Range("B1").Value = "=C3-B3"
Range("C1").Value = Range("B3").Value
daycount = 0
daycountend = Range("B1").Value
On Error GoTo line1
While daycount <= daycountend
Range("D1").Value = Range("C1").Value + daycount
Range("E1").Value = "=TEXT(D1,""dd"")"
Range("F1").Value = "=TEXT(D1,""mm"")"
Range("G1").Value = "=TEXT(D1,""yy"")"
startday = Range("E1").Value
startmonth = Range("F1").Value
startyear = Range("G1").Value
'download file==========================================
Dim WebUrlStr As String, LocalFile As String
Dim oXMLHTTP As Object, bArray() As Byte, hfile As Integer
Dim tempWb As Workbook, newWb As Workbook
Dim MyRange As Range
Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
'download the file from the web to the hardrive
WebUrlStr = "http://www.bseindia.com/bhavcopy/eq" + CStr(startday) + "" + CStr(startmonth) + "" + CStr(startyear) + "_csv.zip"
LocalFile = "E:\Macros\BseDailyBhav\eq" + CStr(startday) + "" + CStr(startmonth) + "" + CStr(startyear) + "_csv.zip"
oXMLHTTP.Open "GET", WebUrlStr, False
oXMLHTTP.send
bArray = oXMLHTTP.ResponseBody
hfile = 1
Open LocalFile For Binary As #hfile
Put #hfile, , bArray
Close #hfile
Set oXMLHTTP = Nothing
'unzip file================================================
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Fname = "E:\Macros\BseDailyBhav\eq" + CStr(startday) + "" + CStr(startmonth) + "" + CStr(startyear) + "_csv.zip"
If Fname = False Then
'Do nothing
Else
'Destination folder
DefPath = "E:\Macros\BseDailyBhav\" '<<< Change path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
' 'Delete all the files in the folder DefPath first if you want
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
' MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
Kill "E:\Macros\BseDailyBhav\*.Zip*"
On Error GoTo 0
daycount = daycount + 1
Wend
GoTo line2
line1:
MsgBox "Download Unsucessful. Kindly check Dates entered"
line2:
Range("B1:G1").ClearContents
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("B3").Value = "mm/dd/yyyy"
Range("C3").Value = "mm/dd/yyyy"
ActiveWorkbook.Save
End Sub
