unable to download & save file

cds

Board Regular
Joined
Mar 25, 2012
Messages
84
i AM USING the following Leith Ross function to download file from the website named "http://www.bseindia.com/markets/equity/EQReports/Equitydebcopy.aspx", which generate the historical bhav copy. It gives error status 301 if I run "geturlstatus" macro, If I run downloadfile macro, I am not able to save the file . Please guide me.

'Written: March 15, 2011
'Author: Leith Ross

Public PageSource As String
Public httpRequest As Object

Function GETURLSTATUS(ByVal URL As String, Optional AllowRedirects As Boolean)
Const WinHttpRequestOption_UserAgentString = 0
Const WinHttpRequestOption_EnableRedirects = 6

On Error Resume Next
Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
If httpRequest Is Nothing Then
Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5")
End If
Err.Clear
On Error GoTo 0

httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
httpRequest.Option(WinHttpRequestOption_EnableRedirects) = AllowRedirects

'Clear any pervious web page source information
PageSource = ""

'Add protocol if missing
If InStr(1, URL, "://") = 0 Then
URL = "http://" & URL
End If

'Launch the HTTP httpRequest synchronously
On Error Resume Next
httpRequest.Open "GET", URL, False
If Err.Number <> 0 Then
'Handle connection errors
GETURLSTATUS = Err.Description
Err.Clear
Exit Function
End If
On Error GoTo 0

'Send the http httpRequest for server status
On Error Resume Next
httpRequest.Send
httpRequest.WaitForResponse
If Err.Number <> 0 Then
' Handle server errors
PageSource = "Error"
GETURLSTATUS = Err.Description
Err.Clear
Else
'Show HTTP response info
GETURLSTATUS = httpRequest.Status & " - " & httpRequest.StatusText
'Save the web page text
PageSource = httpRequest.responsetext
End If
On Error GoTo 0
End Function

Sub GETURLSTATUSN()

Debug.Print GETURLSTATUS("www.bseindia.com/download/BhavCopy/Equity/eq" & Format(dDate, "ddmmyy") & "_csv.zip")
End Sub





Sub DownloadFile()


' Worksheets("CDDOWNLOAD").Activate

Dim StrURL As String
Dim strPath As String
Dim dDate As Date
Dim iRet As Long

dDate = Now() + 1
iRet = 1
vFolderName = "C:\Documents and Settings\Admin\Desktop\CDDOWNLOADS\"
Do While iRet <> 0
dDate = dDate - 1
StrURL = "www.bseindia.com/download/BhavCopy/Equity/eq" & Format(dDate, "ddmmyy") & "_csv.zip"
iRet = Val(GETURLSTATUS(StrURL, False))
strPath = vFolderName & "eq" & Format(dDate, "ddmmyy") & "_csv.zip"
If iRet = 0 Then
MsgBox "File eq" & Format(dDate, "ddmmyy") & "_csv.zip Downloaded"
Else
MsgBox "No File Named eq" & Format(dDate, "ddmmyy") & "_csv.zip"
End If
Loop

end Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Forum statistics

Threads
1,221,310
Messages
6,159,173
Members
451,543
Latest member
cesymcox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top