VBA XML- Import list of daily fx rates

[honurkk]

Hi everyone,

All I want to do is to get specific information from a website as a list.

Below code works just fine and creates list of daily FX rates. But in holidays (e.g. weekends and christmas) the page does not exist so those days are not listed. It lists only workdays. But I need to list every day between the defined dates in Cell "start_date" and "today_date".

But I want to add a condition such as these (stuck on #3 and 4 ):

1- List all dates between beginning and ending to Column A
2- And import the values from the link to corresponding column
3- if the page link gives error or doesn't exists (which means its weekend or holiday) (this link for example: http://www.tcmb.gov.tr/kurlar/201512/27122015.xml),
Copy values from the last workday.

Examples:
Thursday: USD 2.91, EUR 3.01
Friday: USD 2.8, EUR 2.95
Saturday: USD 2.8, EUR 2.95
Sunday: USD 2.8, EUR 2.95

Or;

Monday: USD 2.8, EUR 2.95
Tuesday (assume its holiday): USD 2.8, EUR 2.95
Wednesday (assume its holiday): USD 2.8, EUR 2.95

Thank you in advance for your help and appreciate all suggestions.

Option Explicit
 
Sub main()
    
    Dim Date_Start As Date
    Dim Date_Last As Date
    
    Dim Total_Days As Integer
    Dim Days As Date
    Dim i As Integer
    
    Dim act_row As Range
    Dim FXRate_Header As Range
    
    Date_Start = ws_Veri.Range("start_date").Value
    Date_Last = ws_Veri.Range("today_date").Value
    
    Total_Days = Date_Last - Date_Start + 1
    
    On Error Resume Next
    ws_Veri.Range("C5:G5").Resize(Rows.Count - 5).SpecialCells(xlCellTypeConstants).ClearContents
    
    Err = 0
    Set FXRate_Header = ws_Veri.Range("B4:G4").SpecialCells(xlCellTypeConstants)
   
    If Err <> 0 Then
   
    MsgBox "Please define FX Rates in cells C4:G4 " & vbCrLf & "(e.g., USD, EUR, GBP)", vbCritical
        ws_Veri.Range("C4:G4").Select
        Exit Sub
 
    End If
 
    Set act_row = ws_Veri.Range("B5")
    
    Application.Calculation = xlCalculationManual
    
    frm_Cancel.Show
    
    For i = 0 To Total_Days - 1
    
        Days = Date_Start + i
        
        act_row.Select
 
        Call FXRATES_XML(Days, act_row, FXRate_Header)
        DoEvents
    
    Next i
    
    Unload frm_Cancel
    
    Application.Calculation = xlCalculationAutomatic
    
    ws_Veri.Range("A1").Select
    
End Sub
 
 
Sub FXRATES_XML(ByVal Days As Date, ByRef act_row As Range, FXRate_Header As Range)
    Dim objXML As Object
    Dim nd_Tarih_Date As Object
    Dim nd_Currency As Object
    
    Set objXML = CreateObject("MSXML2.DOMDocument")
    
    Dim i As Integer
    Dim c As Range
    
    Dim dt_Format_as_ddmmyyy As String
    Dim dt_Format_as_yyyymm As String
    
    dt_Format_as_ddmmyyy = Format(gun, "ddmmyyyy")
    dt_Format_as_yyyymm = Format(gun, "yyyymm")
    
    objXML.async = False
    
    If objXML.Load("http://www.tcmb.gov.tr/kurlar/" & dt_Format_as_yyyymm & "/" & dt_Format_as_ddmmyyy & ".xml") Then
        
        act_row(, "A").NumberFormat = "[$-41F]DD-MMM-YYYY DDDD"
        act_row(, "A").Value = Days
 
        For Each nd_Tarih_Date In objXML.selectnodes("Tarih_Date")
            
            For Each nd_Currency In nd_Tarih_Date.selectnodes("Currency")
                
                For Each c In FXRate_Header
                    
                    If nd_Currency.attributes(2).nodevalue = c.Value Then
                        act_row(, c.Column - 1).Value = nd_Currency.childnodes(3).Text
                        Exit For
                    End If
    
                Next c
                
            Next nd_Currency
            
        Next nd_Tarih_Date
 
        Set act_row = act_row.Offset(1)
    Application.Calculation = xlAutomatic
    
    End If
 
End Sub