Pulls Forex data from OANDA

ForexPull.vb

Private Sub ForexPull()

' Created by Joseph H. Mosby on 12/22/2010
' GitHub version removes some employer-specific code

' Declare variables
    Dim rngFXMo As Range
    Dim rngFXDa As Range
    Dim rngFXYe As Range
    Dim strFXMo As String
    Dim strFXDa As String
    Dim strFXYe As String
    Dim strURLInput As String
    Dim QT As QueryTable
    
    Set WSW = Worksheets("FXDataPull")
    Set WSR = Worksheets("FX Rates")
      
' Pick up Month, Day, Year from inputs and mash into one string
    Set rngFXMo = WSR.Range("B2")
    Set rngFXDa = WSR.Range("B3")
    Set rngFXYe = WSR.Range("B4")
    strFXMo = rngFXMo.Value
    strFXDa = rngFXDa.Value
    strFXYe = rngFXYe.Value
    strURLInput = strFXMo + "/" + strFXDa + "/" + strFXYe

' Create the OANDA currency converter web reference
    
    ConnectString = "URL;http://www.oanda.com/convert/fxdaily?redirected=1&date=" & strURLInput & "&date_fmt=us&exch=USD&format=HTML&dest=GET+CUSTOM+TABLE&sel_list=ADF_ADP_AED_AFN_ALL_AMD_ANG_AOA_AON_ARS_ATS_AUD_AWG_AZM_AZN_BAM_BBD_BDT_BEF_BGN_BHD_BIF_BMD_BND_BOB_BRL_BSD_BTN_BWP_BYR_BZD_CAD_CDF_CHF_CLP_CNY_COP_CRC_CUC_CUP_CVE_CYP_CZK_DEM_DJF_DKK_DOP_DZD_ECS_EEK_EGP_ESP_ETB_EUR_FIM_FJD_FKP_FRF_GBP_GEL_GHC_GHS_GIP_GMD_GNF_GRD_GTQ_GYD_HKD_HNL_HRK_HTG_HUF_IDR_IEP_ILS_INR_IQD_IRR_ISK_ITL_JMD_JOD_JPY_KES_KGS_KHR_KMF_KPW_KRW_KWD_KYD_KZT_LAK_LBP_LKR_LRD_LSL_LTL_LUF_LVL_LYD_MAD_MDL_MGA_MGF_MKD_MMK_MNT_MOP_MRO_MTL_MUR_MVR_MWK_MXN_MYR_MZM_MZN_NAD_NGN_NIO_NLG_NOK_NPR_NZD_OMR_PAB_PEN_PGK_PHP_PKR_PLN_PTE_PYG_QAR_ROL_RON_RSD_RUB_RWF_SAR_SBD_SCR_SDD_SDG_SDP_SEK_SGD_SHP_SIT_SKK_SLL_SOS_SRD_SRG_STD_SVC_SYP_SZL_THB_TJS_TMM_TMT_TND_TOP_TRL_TRY_TTD_TWD_TZS_UAH_UGX_USD_UYU_UZS_VEB_VEF_VND_VUV_WST_XAF_XAG_XAU_XCD_XEU_XOF_XPD_XPF_XPT_YER_YUN_ZAR_ZMK_ZWD&value=1"

' Clear all existing query tables to give a blank worksheet
    For Each QT In WSW.QueryTables
        QT.Delete
    Next QT
    
    WSW.Cells.Clear
    
' Release the kraken
    Set QT = WSW.QueryTables.Add(Connection:=ConnectString, Destination:=WSW.Range("A1"))

    With QT
        .Name = "Forex Pull"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .RefreshPeriod = 0
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .WebSelectionType = xlAllTables 'This picks up all tables in the sheet. Unfortunately necessary.
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
    End With
    
    QT.Refresh BackgroundQuery:=True
    
' Prepare for data copy
    
    WSW.Activate
    MsgBox ("Query will take ~15 seconds to complete. Click OK to continue.")
    
    WSW.Range("D6:D200").Copy

End Sub