Sub GetFiles()
'
'27/11/2017 - Haluk ®
'
Dim IE As Object, URL As String
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim RetVal As Variant
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object, WshShell As Object
Dim strMyDocuments As String
Dim i As Integer, j As Integer
URL = "https://www.rbi.org.in/Scripts/WSSViewDetail.aspx?TYPE=Section&PARAM1=2#"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
Set HTML_Body = IE.document.Body
Set HTML_Tables = HTML_Body.GetElementsByTagName("Table")
Set MyTable = HTML_Tables(1)
For i = 1 To 1374 Step 2
j = j + 1
RetVal = MyTable.Rows(i).Cells(1).InnerHTML
x2 = InStr(1, RetVal, "target")
Range("A" & j) = Mid(RetVal, 51, x2 - 51 - 2)
Range("B" & j) = MyTable.Rows(i - 1).Cells(0).InnerText
Next
End With
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
Set WshShell = CreateObject("WScript.Shell")
strMyDocuments = WshShell.SpecialFolders("MyDocuments")
MyFolder = strMyDocuments & "\Foreign_Exchange_Reserves"
If Dir(MyFolder, vbDirectory) = Empty Then MkDir MyFolder
For i = 1 To 5
DoEvents
Cells(i, 4).Select
On Error GoTo ErrHandler:
MyFile = "http://rbidocs.rbi.org.in/rdocs/Wss/DOCs/" & Cells(i, 1)
WHTTP.Open "GET", MyFile, False
WHTTP.Send
FileData = WHTTP.ResponseBody
FileNum = FreeFile
Open MyFolder & "\" & Cells(i, 1) For Binary Access Write As #FileNum
Put #FileNum, , FileData
Close #FileNum
Cells(i, 3) = "Download completed"
GoTo NextItem:
ErrHandler:
Cells(i, 3) = "Download NOT completed"
NextItem:
Next
MsgBox "Open the folder " & MyFolder & " to view the downladed files ..."
Set WHTTP = Nothing
IE.Quit
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
End Sub
