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
'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