VBA/Excel/Access/Word/Access/QueryTable

Building a New Web Query with VBA

 
Sub CreateNewQuery()
    Dim WSD As Worksheet
    Dim WSW As Worksheet
    Dim myQueryTable As QueryTable
    Dim FinalRow As Long
    Dim i As Integer
    Dim ConnectString As String
    Dim FinalResultRow As Long
    Dim RowCount As Long
    Set WSD = Worksheets("Portfolio")
    Set WSW = Worksheets("Workspace")
    FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To FinalRow
        Select Case i
            Case 2
                ConnectString = "URL;http://finance.Yahoo.ru/q/cq?d=v1&s=" & WSD.Cells(i, 1).Value
            Case Else
                ConnectString = ConnectString & "%2c+" & WSD.Cells(i, 1).Value
        End Select
    Next i
    For Each myQueryTable In WSW.QueryTables
        myQueryTable.Delete
    Next myQueryTable
    Set myQueryTable = WSW.QueryTables.Add(Connection:=ConnectString, _
        Destination:=WSW.Range("A1"))
    With myQueryTable
        .Name = "portfolio"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "11"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
    End With
    myQueryTable.Refresh BackgroundQuery:=False
    FinalResultRow = WSW.Cells(Rows,Count, 1).End(xlUp).Row
    WSW.Cells(1, 1).Resize(FinalResultRow, 7).Name = "WebInfo"
    RowCount = FinalRow - 1
    WSD.Cells(2, 2).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,3,False)"
    WSD.Cells(2, 3).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,4,False)"
    WSD.Cells(2, 4).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,5,False)"
    WSD.Cells(2, 5).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,6,False)"
    WSD.Cells(2, 6).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,2,False)"
End Sub

creates a QueryTable object on the active worksheet and sets its data source to a single table from a Web page at the designated location:

 
Public Sub ImportWeb()
   Dim qt As QueryTable
   Set qt = ActiveSheet.QueryTables.Add(Connection:=" URL;http://finance.yahoo.ru/q?s=^DJI&d=v1", _
        Destination:=Range("A1"))
    With qt
        .name = "DJIQuery"
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "16"    " DJI table
        .WebFormatting = xlWebFormattingNone
        .EnableRefresh = True
        .RefreshPeriod = 5   "Unit in minutes
        .Refresh     "Execute query
    End With
    Set qt = Nothing
End Sub

Using VBA to Update an Existing Web Query

 
Sub RefreshAllWebQueries()
    Dim QT As QueryTable
    For Each QT In ActiveSheet.QueryTables
        Application.StatusBar = "Refreshing " & QT.Connection
        QT.Refresh
    Next QT
    Application.StatusBar = False
End Sub