使用Excel获取表VBA可以使用用户名和登录名 [英] Getting a Table using Excel VBA behiind a username and login
问题描述
我的代码如下。我打了一个路障，我发现那里的大多数指南都不能与这个网站一起使用。欣赏您的帮助。
私人子工作表_Change（ByVal Target As Range）
Dim KeyCells As Range
'变量KeyCells包含更改时会导致警报的单元格。
设置KeyCells = Range（H1）
如果不是Application.Intersect（KeyCells，Range（Target.Address））没有，然后
'清除Sheet 1的内容
'
工作表（Sheet1）。Cells.Clear
范围（A1）。选择
'
'登录网站
'
Dim IE As Object
设置IE = CreateObject（InternetExplorer.application）
与IE
.Visible = True
.navigate （https://www.gurufocus.com/forum/login.php?0）
虽然.Busy或.readyState<> 4：DoEvents：Wend
.document.all（Template_GLE_Login_LoginView1_login_UserName）。Focus
.document.all（Template_GLE_Login_LoginView1_login_UserName）。Value =Username
.document。全部（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）。点击
而.Busy或.readyState<> 4：DoEvents：Wend
Debug.Print .LocationURL
结束与
'
'取票单空白单元格H1
Dim Ticker As String
Ticker = Sheets（Blank）。Range（H1）
URL =URL; http：//www.gurufocus.com/financials/& Ticket
'
'从网站
Range（A1）获取数据。选择
with Sheets（Sheet1）。QueryTables.Add（Connection：= URL，目的地：= 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
'.W ebPreFormattedTextToColumns = True
'.WebConsecutiveDelimitersAsOne = True
'.WebSingleBlockTextImport = False
'.WebDisableDateRecognition = False
'.WebDisableRedirections = False
.Refresh BackgroundQuery：= False
结束
如果
结束Sub
首先，我建议您尽快离开 Worksheet_Change 事件宏。各种事情可能会出错，而您被困在那里处理长度例程，并启动InternetExplorer对象来抓取网络数据是最慢的。
Private Sub Worksheet_Change（ByVal Target As Range）
Dim KeyCells As Range
设置KeyCells = Range（H1）
如果不是Application.Intersect（KeyCells ，Target）Is Nothing Then
错误GoTo bm_Safe_Exit
Application.EnableEvents = False
工作表（Sheet1）。Cells.Clear
'如果这是Sheet1的Worksheet_Change然后以下
'将更简洁，并承认我们在Sheet1的bailywick
'Me.Cells.Clear
'范围（A1）。选择尝试工作没有。选择
'允许1秒钟离开Worksheet_Change
Application.OnTime Now + TimeSerial（0，0，1），process_Web_Data
结束如果
bm_Safe_Exit：
Ap plication.EnableEvents = True
End Sub
所以所有这一切都是陷阱和评估事件。如果涉及H1，它将清除Sheet1，并启动一个公共子（存储在模块表中），并且脱离Dodge。次启动在计划之后是次要的次数，应该足够的时间来退出事件宏。
在模块工作表中：
我向VBE的工具添加了Microsoft HTML对象库和Microsoft Internet控件►以下代码的引用。
Sub process_Web_Data（）
Dim ie As New SHDocVw.InternetExplorer
With ie
.Visible = True
.navigatehttps://www.gurufocus.com/forum/login.php?0
While .Busy或.readyState<> 4：DoEvents：Wend
带有.document
.getelementbyid（txt-username）。Value =Username
.getelementbyid（txt-password）。 =密码
.getelementbyid（login_form）。提交
结束
虽然.Busy或.readyState<> 4：DoEvents：Wend
Debug.Print .LocationURL
'-----------------
'做所有其他的这里的东西
'-----------------
结束
结束Sub
这足以让登录页面的找不到电子邮件/用户名/密码或无效。请重试。屏幕，因此登录过程正在运行;只是不是凭据。
至于从该公共子参考Sheet1， Worksheet.CodeName属性， Worksheet.Name属性或工作表。可以使用索引属性。我可能会选择代号。
I am trying to get a table from 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 ("https://www.gurufocus.com/forum/login.php?0")
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://www.gurufocus.com/financials/" & 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
First off, I would suggest that you get out of the Worksheet_Change event macro as soon as possible. All kinds of things can go wrong while you are stuck there processing a length routine and launching an InternetExplorer object to scrape web data is one of the slowest.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("H1")
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Worksheets("Sheet1").Cells.Clear
'if this is Sheet1's Worksheet_Change then the following
'would be more succinct and acknowledges that we are in Sheet1's bailywick
'Me.Cells.Clear
'Range("A1").Select try to work without .Select
'allow 1 second to get out of the Worksheet_Change
Application.OnTime Now + TimeSerial(0, 0, 1), "process_Web_Data"
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
So all that does is trap and evaluate the event. If H1 is involved, it clears Sheet1 and launches a public sub (stored in a Module sheet) and gets out of Dodge. The sub launch is a scant second after being scheduled and that should be more than enough time to exit the event macro.
In a module sheet:
I added Microsoft HTML Object library and Microsoft Internet controls to the VBE's Tools ► References for the following code.
Sub process_Web_Data()
Dim ie As New SHDocVw.InternetExplorer
With ie
.Visible = True
.navigate "https://www.gurufocus.com/forum/login.php?0"
While .Busy Or .readyState <> 4: DoEvents: Wend
With .document
.getelementbyid("txt-username").Value = "Username"
.getelementbyid("txt-password").Value = "Password"
.getelementbyid("login_form").submit
End With
While .Busy Or .readyState <> 4: DoEvents: Wend
Debug.Print .LocationURL
'-----------------
'do all of your other stuff here
'-----------------
End With
End Sub
That is sufficient to get the log in page's 'That Email/username/password was not found or is inactive. Please try again.' screen so the login process is working; just not the credentials.
As far as referencing Sheet1 from that public sub, the Worksheet.CodeName property, Worksheet.Name property or Worksheet.Index property could be used. I would probably opt for the codename.
这篇关于使用Excel获取表VBA可以使用用户名和登录名的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
