'---------------------------------------------------------------------------
' getCurs Data
' Ver$ 0.3
' 11.10.2011
'---------------------------------------------------------------------------

'- Public Names -----------------------
Public WBwork As String                             ' WorkbookName
' Public worksheetname As String                    ' Sheet Name
'---------------------------------------------------------------------------


'---------------------------------------------------------------------------
Private Sub getCurs()
'---------------------------------------------------------------------------
Dim ErrorNumber As String

Dim sURI As String
Dim oHttp As Object
Dim htmlcode As String
Dim outUSD As String
Dim outEURO As String
    
Dim posEuro As String
Dim posUSD As String
Dim posData As String

Dim curentDate As Date

Dim curerntYear As Integer
Dim curerntMonth As Integer
Dim curerntDay As Integer

Dim RequestDate As String
'---------------------------------------------------------------------------
    Application.ScreenUpdating = False
    
    posEuro = "K1"
    posUSD = "I1"
    posData = "P1"
    
    WBwork = ActiveWorkbook.NAME
    worksheetname = ActiveSheet.NAME
    
    If ActiveWorkbook Is Nothing Then
        MsgBox "Откройте и заполните расчётный файл"
         GoTo errorException
    End If

    On Error GoTo errorException
    
    If isWorksheetExists(WorkBookName:=WBwork, worksheetname:=worksheetname) = False Then
        GoTo errorException
    End If

' check header
    curentDate = Range(posData).Value

    If (curentDate < "01.07.1992" Or curentDate > Date) Then
        curentDate = Format(Date, "dd.mm.yy")
    End If

    
    
    sURI = "http://www.cbr.ru/currency_base/daily/?date_req=" & curentDate

    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    
    If Err.Number <> 0 Then
        Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
    End If

    If oHttp Is Nothing Then
        GoTo errorException
    End If
       
    oHttp.Open "GET", sURI, False
    oHttp.Send
    
    htmlcode = oHttp.responseText

    
    outEURO = Mid(htmlcode, InStr(1, htmlcode, "EUR") + 41, 7)
    outUSD = Mid(htmlcode, InStr(1, htmlcode, "USD") + 47, 7)
     
    If decsep = "." Then
        outEURO = Replace(outEURO, ",", ".")
        outUSD = Replace(outUSD, ",", ".")
    End If
    
    If Not IsNumeric(outEURO) And IsNumeric(outUSD) Then
        MsgBox "Error numeric data!", 48, "Ошибка"
        GoTo errorException
    End If

    Set oHttp = Nothing

' past Data into Table
    For Each cnSheet In Worksheets
    
        If cnSheet.NAME = worksheetname Then
        
            With cnSheet
                .Range(posEuro).Formula = CDbl(outEURO)
                .Range(posData).Value = curentDate
                .Range(posUSD).Formula = CDbl(outUSD)
            End With
        
        End If
    Next cnSheet

errorException:
    ErrorNumber = Err.Number
     
    Application.ScreenUpdating = True
    Exit Sub

End Sub


'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------