Building a New Web Query with VBA : QueryTable « Access « VBA / Excel / Access / Word

1. VBA / Excel / Access / Word
2. Access
3. 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.com/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

 

Related examples in the same category