Question

*这适用于Excel的VBA 这可能只是我的一个愚蠢的逻辑错误，但我已经在这个工作了几个小时，我似乎无法弄明白：

我有一个网页，其中包含我需要访问的两个链接。这两个链接每天都在变化，但始终具有相同的开始序列（示例.... Google网站几乎总是以“http://www.google.com”开头）

我有代码搜索所有“a”HTML标记，以查找包含特定文本的链接（例如“google”）。如果找到了链接，我需要点击该链接，然后返回（通过objIE.Back）和继续循环序列而不重置 。这是我遇到麻烦的最后一部分。我的代码抓住了它看到的第一个链接，做了我想要它做的事情，回过头来，但是它似乎不记得它已经处理了第一个链接并且它只是不断重复这个发现第一个链接。

任何人都可以看看我有什么，并告诉我哪里出错了？编辑：我已使用愚蠢的循环更新了当前代码并删除了“End For”。同样的事情正在发生。我哪里出错了？

Sub Button17_Click()
Dim objIE As SHDocVw.InternetExplorer
Dim OrgBox As HTMLInputElement
Dim ticketnumber As String
Dim Error As String
Dim subaccnum As String
Dim IEURL As String
Dim button As Object
Dim ele As Object
Dim NodeList As Object
Dim tagName As Object
Dim elementid As Object
Dim Tag As Object
Dim hrefvalue As String
Dim hrefurlvalue As String
Dim trimedhrefvalue As String
Dim ieLinks As Object
Dim Links As Object
Dim ieAnchors As Object
Dim Anchor As Object
Dim I As Integer



Sheets("Sheet1").Activate
Range("A5").Value = ""
Range("A9").Value = ""
subaccnum = Range("A2").Value
 On Error Resume Next
 Application.StatusBar = "Opening Internet Explorer"
Set objIE = New InternetExplorerMedium
objIE.navigate "http://www.youtube.com" ' This is just a test website as my website is under a private VPN and cannot be accessed by anyone but me. Website should not effect loop though
    objIE.Visible = True 'False
     Application.StatusBar = "Loading website..."
    Do While objIE.readyState < 4: Loop

Set objIE2 = Nothing
'Call Wait
Application.Wait (Now + TimeValue("0:00:3"))




 Application.StatusBar = "Trying to find link..."
        Application.Wait (Now() + TimeValue("00:00:05"))
        'objIE.document.parentWindow.execScript "execute('RefreshList');"
        Set ieLinks = objIE.document.getElementsByTagName("a")

        For Each Links In ieLinks
            If Links.outerHTML Like "<A href=""javascript:fnOpenWindow('/ao/party/popuppartyinfo?partyId=*" Then
                'Links.Click
                Application.StatusBar = "Found link! Please wait"
                Links.Value = hrefvalue
                trimedhrefvalue = Right(Links, 49)
                hrefurlvalue = "http://www.youtube.com" & trimedhrefvalue
                objIE.navigate hrefurlvalue

 Do While objIE.readyState < 4: Loop
'Call Wait
Application.Wait (Now + TimeValue("0:00:5"))

Application.ScreenUpdating = True
  Application.StatusBar = "Extracting Email From Server..."
IEURL = objIE.LocationURL
'Range("A12").Value = IEURL
ThisWorkbook.Sheets("Import").Activate
Rows("1:500").Delete
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & IEURL, _
        Destination:=Range("a2"))

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


Application.ScreenUpdating = True
Application.StatusBar = "Adding Data to spreadsheet..."

Cells.Find(What:="Email Address", After:=Range("A1"), LookIn:=xlFormulas, Lookat:= _
        xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        ActiveCell.Offset(RowOffset:=0, columnOffset:=1).Activate
    Selection.Copy
    Sheets("Sheet1").Select

    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        Sheets("Import").Select
        If ActiveCell.Offset(RowOffset = 1).Value <> "" Then
        ActiveCell.Offset(RowOffset = 1).Copy
        Sheets("Sheet1").Select
        ActiveCell.Offset(RowOffset = 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        End If


Application.ScreenUpdating = True

 objIE.GoBack
 Do While objIE.readyState < 4: Loop
 'Call Wait
Application.Wait (Now + TimeValue("0:00:4"))

Application.StatusBar = "Searching for 2nd account owner..."

           End If
        Next Links

End Sub

可能的解决方法：

For i = 1 To ieLinks.Length
            If ieLinks.Item(i).outerHTML Like "<A href=""javascript:fnOpenWindow('/ao/party/popuppartyinfo?partyId=*" Then
                'Links.Click


Application.StatusBar = "Found link! Please wait"
            ieLinks.Item(i).Value = hrefvalue
            trimedhrefvalue = Right(ieLinks.Item(i), 49)
            hrefurlvalue = "http://www.youtube.com" & trimedhrefvalue
            objIE.navigate hrefurlvalue
            .....................
Next i

编辑：找到临时解决方案最后，我从来没有得到这个链接工作。我所做的是我将ieLinks.Item（i）分配给电子表格上的随机范围（没有人会滚动到某个地方）。一旦链接在这里，它们将保持静态。然后我只做了一个简单的“为每个Cell in rng”循环遍历每个链接直到结束。这不是我最初要做的，也不是这个问题的确切答案，但它是一个临时解决方案，使得链接的修改比保持VBA内存中的链接容易得多。

Answer 1

摆脱＆＃34;退出＆＃34;它应该转到下一个。

你还没有包含所有的代码，因为这一切似乎都出现在其他循环中（通过底部的＆＃34;循环＆＃34;语句判断没有匹配＆＃34;执行WHile＆＃34;或其他循环结构。您可能会永远循环，具体取决于该循环中发生的事情。

****** **** EDIT

我看到的第二个问题是代码的这一部分：

      If Links.outerHTML Like "<A href=""javascript:fnOpenWindow('/ao/party/popuppartyinfo?partyId=*" Then
            Application.StatusBar = "Found link! Please wait"
            Links.Value = hrefvalue
            trimedhrefvalue = Right(Links, 49)
            hrefurlvalue = "http://www.youtube.com" & trimedhrefvalue
            objIE.navigate hrefurlvalue

            ......

在这里，您正在设置＆＃34; Links.Value＆＃34;到hrefvalue，它还没有被初始化，所以它是一个空字符串。在尝试测试时，它甚至不允许我更改此值并抛出错误，但假设确实如此，则将值设置为＆＃34;＆＃34;，然后获取正确的49个字符它并将其附加到网站上。这似乎会继续打开同一个网站......

'For Each'如果语句循环问题

1 个答案: