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