5

我正在构建一个项目,并且我了解 Excel 2003 支持通过“数据 -> 导入外部数据 -> 新 Web 查询”从外部网页导入数据。

这可以通过此处列出的几个步骤来完成:http: //www.internet4classrooms.com/excel_import.htm

但是,我从中导入数据的站点是一个内部网站(Intranet),每次访问它时都需要登录。

该网站不记得密码,每次我点击“导入”按钮时,由于登录,它什么也不做。

在 Excel 2003 中从外部网站导入数据时,如何提示输入用户名 + 密码并登录网站?

4

2 回答 2

2

大约一年前我遇到了这个问题,正如 JimmyPena 建议的那样,IE 自动化可能是要走的路。这看起来比你预期的要复杂得多,但相信我,我花了几个小时试图找到一种更简单的方法,但找不到。

花一些时间了解 HTML 和 DOM 对象。对于您正在做的事情来说,这似乎有些矫枉过正,但如果您想从网站获取数据,它将派上用场。这是一个脚本,可让您指出正确的方向:

  1. 创建一个带有两个文本框和一个按钮的用户窗体
  2. Textbox1 将是用户名输入,而 textbox2 将是您的密码
  3. 您应该通过在属性窗口中选择一个密码字符来屏蔽密码输入(在 VBA 编辑器中按 F4,从下拉列表中选择 textbox2 并在 PasswordChar 旁边输入一个字符)
  4. 双击刚刚创建的按钮并粘贴以下代码:

    Option Explicit
    
    Private Sub CommandButton1_Click()
    Const READYSTATE_COMPLETE = 4
    Const tempDir As String = "C:\Windows\Temp\"
    
    Dim userName$, passWord$, URL$, s_outerhtml$ ''These are strings
    Dim IE As Object, IE_Element As Object, IE_HTMLCollection As Object
    Dim i_file% ''This is an integer
    Dim blnUsernameEntered As Boolean, blnPasswordEntered As Boolean, blnSheetFnd As Boolean
    Dim ws As Excel.Worksheet
    
    ''Test for missing username or password
    If Me.TextBox1 = vbNullString Then MsgBox "Enter a User Name", vbOKOnly, "User Name Missing": Exit Sub
    If Me.TextBox2 = vbNullString Then MsgBox "Enter a Password", vbOKOnly, "Password Missing": Exit Sub
    
    ''Set the username and password based on the userform inputs
    userName = Me.TextBox1.Value
    passWord = Me.TextBox2.Value
    
    ''Hide the form
    Me.Hide
    
    ''Enter your address to navigate to here
    URL = "http://theofficialjbfansite.webs.com/apps/auth/login"
    
    ''Create an Internet Explorer object if it doesn't exist
    If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
    
    ''Make the window visible with true, hidden with false
    IE.Visible = True
    ''navigate to the website
    IE.Navigate URL
    
    '' use this loop to make wait until the webpage has loaded
    Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
       DoEvents
    Loop
    
    ''This is where it will get tricky - see my notes on DOM at the end of this post
    ''build a collection of input elements
    Set IE_HTMLCollection = IE.document.getElementsByTagName("input")
    ''for each html element in the "input" collection
    For Each IE_Element In IE_HTMLCollection
      If IE_Element.Name = "email" Then IE_Element.innerText = userName:   blnUsernameEntered = True
      If IE_Element.Name = "password" Then IE_Element.innerText = passWord: blnPasswordEntered = True
      If blnUsernameEntered = True And blnPasswordEntered = True Then Exit For
      ''Unblock line below if you are having trouble finding the element name,
      ''view the output in the Immediate Window (Ctrl + G in the VBA Editor)
      ''Debug.Print IE_Element.Name
    Next
    
    ''Find the form and submit it
    Set IE_HTMLCollection = IE.document.getElementsByTagName("form")
    For Each IE_Element In IE_HTMLCollection
       If IE_Element.Name = "loginForm" Then IE_Element.submit
    Next
    
    Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
       DoEvents
    Loop
    
    ''The next line helps ensure that the html has been fully loaded
    Application.Wait Now() + TimeValue("0:00:02")
    s_outerhtml = IE.document.body.OuterHtml
    i_file = FreeFile
    
    
    ''This is a modification of some code I found at www.tek-tips.com <--great resource
    ''the code saves a temporary copy of the webpage to your temp file
    Open tempDir & "\tempFile.htm" For Output As #i_file
    Print #i_file, s_outerhtml
    
    Close #i_file
    
    ''Creating a "Data" sheet if it doesn't exist
    For Each ws In ThisWorkbook.Worksheets
       If ws.Name = "Data" Then blnSheetFnd = True: Exit For
    Next
    
    If blnSheetFnd = False Then Sheets.Add: ActiveSheet.Name = "Data"
    
    Sheets("Data").Cells.Clear
    
    ''Here is your webquery, using the temporary file as its source
    ''this is untested in 2003, if it errors out, record a macro
    ''and replace the property that throws the error with your recorded property
    With Sheets("Data").QueryTables.Add(Connection:= _
        "URL;" & tempDir & "tempFile.htm" _
        , Destination:=Range("$A$1"))
        .Name = "Data"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    ''delete the temporary file
    Kill tempDir & "\tempFile.htm"
    
    ''clean up after yourself, foo!!
    IE.Quit
    Set IE = Nothing
    Set IE_HTMLCollection = Nothing
    Unload UserForm1
    
    End Sub
    
  5. 更改您网站的 URL 并修改getelement方法以使用您的网页

对于不熟悉 HTML 和 DOM(文档对象模型)的人来说,最棘手的部分是在页面上找到正确的元素。

一个好的技巧是使用 Internet Explorer 的开发者工具。在 IE 中打开您的 Intranet 页面,然后按 F12。这将打开开发者工具。单击工具栏中的箭头图标(箭头指向上方和左侧)并切换回您的 Intranet 页面。将鼠标悬停在页面上,您将看到在每个元素周围绘制的蓝色框。将鼠标悬停在用户名登录上,然后单击输入框。这将突出显示源代码中的 HTML。

从这里您可以识别元素 id、名称、标记名和类(如果有的话)。getelementbyID对,等做一些研究,getelementsbytagname或者单步执行上面的代码以了解它是如何工作的。

最后一点,如果您的 Intranet 页面有一个表单元素,您将必须使用上述getelement方法获取表单对象并使用.submit. 如果页面使用按钮对象,则获取按钮元素并使用.click. 祝你好运!

于 2012-07-28T20:08:13.463 回答
0

不确定它是否仍然相关,但我有一个通过宏的解决方案

以下是步骤:

1:在导入新的网络查询时记录你的宏(什么都可以)

2:刷新所有查询。

编辑您的 Web 查询以包括内联用户名/密码。

下面是我的宏:

 Sub xmlUpdate()
'This will enable the import of our XML data. The first part is a dummy import, to    authenticate the Excel file with the iJento servers. The second part (Web_Query_1 is the actual import)
'The sheet is initially inserted as "Dummy" and then promptly deleted.
    Sheets.Add.Name = "Dummy"
    ActiveWorkbook.XmlImport URL:= _
        "https://USERNAME:PASSWORD@SERVER.com/query/app?service=file=201" _
        , ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
    Sheets("Dummy").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    ActiveWorkbook.XmlMaps("Web_Query_1").DataBinding.Refresh
    End Sub

于 2013-06-27T09:08:46.440 回答