Reputation: 47
*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
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