“对于每个”如果语句循环问题

*这是Excel的VBA这可能只是我的一个愚蠢的逻辑错误，但我一直在这个工作了几个小时，我似乎无法弄清楚：

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

我有代码search所有“a”的HTML标签的链接，其中有一定的文字（如“谷歌”）。 如果find链接，我需要点击链接，然后返回 （通过objIE.Back）并继续循环顺序而不重置 。 这是我遇到的最后一部分。 我的代码抓住了它看到的第一个链接，做我希望它做的事情，然后回来， 但似乎并没有记住它已经处理了第一个链接 ，它只是不断重复第一个链接的发现。

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

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 

编辑：find临时解决scheme最后，我从来没有得到该链接工作。 我所做的就是将ieLinks.Item（i）分配给电子表格上的一个随机范围（任何人都不会滚动到的地方）。 一旦链接在这里，他们保持静态。 然后，我只是做了一个简单的“对于每个细胞在rng”循环运行通过每个链接，直到结束。 这不是我原来想要做的，也不是对这个问题的确切答案，但这是一个临时的解决scheme，使链接的修改比保持VBA内存中的链接容易得多。

Answer 1

摆脱“退出”行，它应该去下一个。

你没有包括所有的代码，因为这一切似乎都出现在其他循环（由底部的“循环”语句判断，没有匹配的“做WHILE”或其他循环结构。循环取决于循环中发生的事情。

******编辑****

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

  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 ...... 

在这里，您将“Links.Value”设置为hrefvalue，它尚未初始化，因此它是一个空string。 当试图testing这个，它甚至不会让我改变这个值，并抛出一个错误，但假设它，你设置为“”的价值，然后得到正确的49个字符，并将其附加到网站。 这似乎继续打开同一网站….