JGoldz75
JGoldz75

Reputation: 47

'For Each' If Statement Loop Issues

*This is for Excel's VBA This is probably just a stupid logic error on my part but I've been working on this for hours and I just can't seem to figure it out:

I have a webpage with two links I need to access. These two links are changing daily, but always have the same beginning sequence (Example.... Google websites almost always begin with "http://www.google.com")

I have the code to search through all "a" HTML tags for links that have certain text in them (like "google"). If the link is found, I need to click the link, then go back (via objIE.Back) and continue the loop sequence without resetting. It is this last part that I am having trouble with. My code grabs the first link it see's, does what I want it to do, goes back, but then it doesn't seem to remember that it already handled the first link and it just keeps repeating the finding of that first link.

Can anyone take a look at what I have and tell me where I went wrong? Edit: I have updated this with my current code with the stupid loop and "End For" deleted. Same thing is happening though. Where did I go wrong?

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

Possible workaround:

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

EDIT: TEMPORARY SOLUTION FOUND In the end, I never did get that link to work. What I did was that I assigned the ieLinks.Item(i) to a random range on the spreadsheet (somewhere nobody will ever scroll to). Once the links are here, they remain static. Then I just made a simple "For each Cell in rng" loop to run through each link until the end. This is not what I originally set out to do, nor is it an exact answer to this question, but it is a temporary solution that makes the modification of the links much easier than keeping the links in VBA's memory.

Upvotes: 0

Views: 179

Answers (1)

OpiesDad
OpiesDad

Reputation: 3435

Get rid of the "Exit For" line and it should go to the next one.

You haven't included all of the code, as this all seems to appear within some other loop (judging by the "Loop" statement at the bottom that doesn't have a matching "Do WHile" or other loop structure. You may be looping forever depending on what is happening in that loop.

******EDIT****

The second problem I see is in this part of the code:

      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

            ......

Here, you are setting "Links.Value" to hrefvalue, which hasn't been initialized, so it is an empty string. When trying to test this, it wouldn't even let me change this value and threw an error, but assuming that it does, you are setting the value to "", then getting the right 49 characters of it and appending it to the website. This would seem to keep opening the same website....

Upvotes: 2

Related Questions