mercredi 29 juillet 2015

Getting a Table using Excel VBA behiind a username and login

I have basic excel vba knowledge and is trying to get a table in a website. The problem is that I need to login first in-order to access this information.

My code is below. I have hit a road block and most of the guides I found out there do not work with this site. Appreciate your help.

Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range

' The variable KeyCells contains the cells that will cause an alert when they are changed.
Set KeyCells = Range("H1")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then
        ' Clear contents of Sheet 1
        '
        Worksheets("Sheet1").Cells.Clear
        Range("A1").Select
        '
        'Login to the website
        '
        Dim IE As Object

        Set IE = CreateObject("InternetExplorer.application")

        With IE
            .Visible = True
            .navigate ("http://ift.tt/1Dat2n7")

            While .Busy Or .readyState <> 4: DoEvents: Wend

            .document.all("Template_GLE_Login_LoginView1_login_UserName").Focus
            .document.all("Template_GLE_Login_LoginView1_login_UserName").Value = "Username"
            .document.all("Template_GLE_Login_LoginView1_login_Password").Focus
            .document.all("Template_GLE_Login_LoginView1_login_Password").Value = "Password"
            .document.all("Template_GLE_Login_LoginView1_login_LoginButton").Click

            While .Busy Or .readyState <> 4: DoEvents: Wend
            Debug.Print .LocationURL
        End With
        '
        ' take the Ticker in sheet Blank cell H1
        Dim Ticker As String
        Ticker = Sheets("Blank").Range("H1")
        URL = "URL;http://ift.tt/1ASDSrQ" & Ticker
    '
    ' get the data from the website
        Range("A1").Select
        With Sheets("Sheet1").QueryTables.Add(Connection:=URL, Destination:=Sheets("Sheet1").Range("$A$1"))
    '        .CommandType = 0
            .Name = Ticker
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
    '        .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
    '        .RefreshPeriod = 0
    '        .WebSelectionType = xlSpecifiedTables
    '        .WebFormatting = xlWebFormattingNone
    '        .WebTables = """Rf"""
    '        .WebPreFormattedTextToColumns = True
    '        .WebConsecutiveDelimitersAsOne = True
    '        .WebSingleBlockTextImport = False
    '        .WebDisableDateRecognition = False
    '        .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

End If

End Sub




Aucun commentaire:

Enregistrer un commentaire