Calendar Pop Up and Loop using VBA

[zaska]

Hello,

I would like to know how to use calendar Pop in the below code for selecting date in Range " B1" and how to use loop in the below code so that the code can process data between two dates selected from calender pop ups.

Public Sub downloadNse()
Dim arrURL() As String
Dim dtmDate As Date
Dim c As Range
Dim i As Long
Dim s As String
Dim bArray() As Byte
Dim hFile As Integer
Dim strLocalFile As String
Dim sTemp As String
Dim iPtr As Long

 
Dim oXMLHTTP As MSXML2.XMLHTTP '(reference to C:\Windows\System32\msxml2.dll for 32 bit systems)

    '-------------------------------------------------------------------------------
    'ENTER CONSTANTS HERE - NOTHING ELSE *SHOULD* NEED TO BE CHANGED
    Const CELL_WITH_DATE As String = "B1"
    Const RANGE_WITH_SYMBOLS As String = "A1:A19"
    Const SAVE_DIRECTORY As String = "E:\Macros\Output\Indices\" 'end with forward slash
    '-------------------------------------------------------------------------------
    
    dtmDate = Range(CELL_WITH_DATE).Value '//Date
    strLocalFile = SAVE_DIRECTORY & Format(dtmDate, "dd-mm-yyyy") & "_.csv"
    For Each c In Range(RANGE_WITH_SYMBOLS) '//11 cells with symbols
        If Len(c.Value) > 0 Then
            ReDim Preserve arrURL(1 To 2, 0 To i)
            arrURL(1, i) = "http://www.nseindia.com/content/indices/histdata/"
            arrURL(1, i) = arrURL(1, i) & UCase(c.Value)
            arrURL(2, i) = UCase(c.Value)
            arrURL(1, i) = arrURL(1, i) & Format(dtmDate, "dd-mm-yyyy") & "-" & Format(dtmDate, "dd-mm-yyyy") & ".csv"
            i = i + 1
        End If
    Next c
    
    'download the file from the web to the hardrive
    'loop through symbols in turn
    Set oXMLHTTP = New XMLHTTP
    hFile = FreeFile
    Open strLocalFile For Binary As #hFile
    For i = 0 To UBound(arrURL, 2)
        oXMLHTTP.Open "GET", arrURL(1, i), False
        oXMLHTTP.send
        'Wait for request to finish
        Do While oXMLHTTP.readyState <> 4
            DoEvents
        Loop
        
        bArray = oXMLHTTP.responseBody
       

        sTemp = ""

        For iPtr = LBound(bArray) To UBound(bArray)

          sTemp = sTemp & Chr(bArray(iPtr))

        Next iPtr

        sTemp = Replace(sTemp, "Date", "")

        sTemp = Replace(sTemp, "Open", "")

        sTemp = Replace(sTemp, "High", "")

        sTemp = Replace(sTemp, "Low", "")

        sTemp = Replace(sTemp, "Close", "")

        sTemp = Replace(sTemp, "Shares Traded", "")

        sTemp = Replace(sTemp, "Turnover (Rs. Cr)", "")

        If Left(sTemp, 2) = Chr(34) & Chr(34) Then

          sTemp = Mid(sTemp, 3)

        End If

        Do While Left(sTemp, 3) = "," & Chr(34) & Chr(34)

          sTemp = Mid(sTemp, 4)

        Loop

        If Left(sTemp, 1) = Chr(10) Then sTemp = Mid(sTemp, 2)

        ReDim bArray(Len(sTemp) - 1)

       

        Put #hFile, , arrURL(2, i) & "," & sTemp

 
              
       Next i

Handler:
On Error Resume Next
Close #hFile
Set oXMLHTTP = Nothing

End Sub

Regards,

Zaska

 

[zaska]

Can anyone help me ?

 

[zaska]

Hi,

I kindly request seniors to see my query

Thanks