getting links from InternetExplorer.Application

leeple

New Member
Joined
Feb 16, 2011
Messages
5
Hi, I have a have been using VBA for under a year, never posted anything, but I am having a lot of trouble with my function being non-deterministic. I need to check web pages, look through their links (put them into an array), and check if another webpage is one of those links. Here is the important part of my code as it stands

Private Sub TestLink(ColumnNumSite As Integer, RowNum As Integer, ColumnNum As Integer)
Dim lnk
Dim MyNames() As String ' declares a dynamic array variable
Dim iCount As Integer
Dim Max As Integer
Dim ie As InternetExplorer
Dim lngLoc As Long

Set ie = CreateObject("InternetExplorer.Application")
With ie
'.Visible = True
.Navigate Cells(RowNum, ColumnNumSite)
Do Until .ReadyState = 4: DoEvents: Loop

Set doc = ie.Document
Max = doc.Links.length
ReDim MyNames(1 To Max + 2)
iCount = 1
For Each lnk In doc.Links
' finds the maximum array size
'For iCount = 1 To Max
MyNames(iCount) = lnk
'ActiveSheet.Cells(RowNum + iCount - 1, 6 + iCount) = lnk
iCount = iCount + 1
'MyNames(iCount) = ThisWorkbook.Names(iCount)
Next
lngLoc = -9
On Error Resume Next
lngLoc = Application.WorksheetFunction.Match(ActiveSheet.Cells(RowNum, ColumnNum).Formula(), MyNames(), 0)

ActiveSheet.Cells(RowNum, ColumnNumSite + 5).Value() = lngLoc
If (lngLoc = -9) Then
ActiveSheet.Cells(RowNum, ColumnNumSite + 4).Value() = "Link Does not Exist"
Else: ActiveSheet.Cells(RowNum, ColumnNumSite + 4).Value() = "Link Exists"
End If
.Quit
End With
End Sub

Right now whats happening is max gets set to a very small value ocassionally (around 3 or 28), but if I pause it and rerun that line it will recieve its full normal value. This is not the entire problem because I tried to
ReDim MyNames(1 To 1000)
instead of to Max, and it broke anyways, the breaking occurs because
For Each lnk In doc.Links
does not go through all the links sometimes, which I know because when I pause it afterwards and rerun that area I get the correct solution. Does anyone know whats going on? All I need is to set an array to the links of a webpage
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello leeple,

Object collections in Internet Explorer are not the same as in VBA and as you found out the For Each Next construct doesn't work. Two other things to keep in mind are these collections are zero based and the Length property is always +1 greater than the objects the collection holds.

Try this version of your macro out and let me know how it works.
Code:
Private Sub TestLink(ColumnNumSite As Integer, RowNum As Integer, ColumnNum As Integer)

  Dim docLinks As Object
  Dim lnk As Object
  Dim MyNames() As String ' declares a dynamic array variable
  Dim I As Integer
  Dim iCount As Integer
  Dim Max As Integer
  Dim ie As InternetExplorer
  Dim lngLoc As Long

    Set ie = CreateObject("InternetExplorer.Application")
    
    With ie
    
     '.Visible = True
      .Navigate Cells(RowNum, ColumnNumSite)
      While .Busy And .ReadyState <> 4: DoEvents: Wend

      Set doc = ie.Document
      
    'Get the Link Objects
      Set docLinks = doc.Anchors
      
      'Check document has Links
        If Not docLinks Is Nothing Then
         'Save each URL to MyNames array
           For I = 0 To docLinks.Length - 1
             'Resize the array keeping the previous values and store the URL
               ReDim Preserve MyNames(I)
               MyNames(I) = docLinks(I).href
           Next I
        End If

      lngLoc = -9
        
      On Error Resume Next
      lngLoc = Application.WorksheetFunction.Match(ActiveSheet.Cells(RowNum, ColumnNum).Formula(), MyNames(), 0)

      ActiveSheet.Cells(RowNum, ColumnNumSite + 5).Value() = lngLoc
        
      If (lngLoc = -9) Then
         ActiveSheet.Cells(RowNum, ColumnNumSite + 4).Value() = "Link Does not Exist"
      Else
         ActiveSheet.Cells(RowNum, ColumnNumSite + 4).Value() = "Link Exists"
      End If
        
      .Quit
      
    End With
    
End Sub
Sincerely,
Leith Ross
 
Last edited:

leeple

New Member
Joined
Feb 16, 2011
Messages
5
Hi,

Thanks for the quick response, sorry it has taken me so long (I'm an intern at work, still at school, and had a midterm this morning).

I am very grateful for your suggestion but currently the code is not functional. By this I mean websites that link to other websites are evaluating to say that they do not contain a link to the letter site.

Links.length - 1 evaluates to 40-50 a lot of times when there are about 250-400 links on the web page

Can I ask a couple questions: what are anchors and what is an anchor.href supposed to yield? Is there a library or api for the internet explorer functions like this within internet explorer? Also, is there a way to force excel to flush memory such that previous ie objects cannot possibly interfere with future ones?

Would it help if I posted the methods calling this function so you could test if youre not exactly sure about functionality?
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello leeple,

Midterms, that brings back flashbacks, I mean memories. Hope you did well.

If you could post the code with the site you want to link to, it would be helpful.

Sincerely,
Leith Ross
 

leeple

New Member
Joined
Feb 16, 2011
Messages
5
'''sidenote: I took up this project started by someone else in my office and have not messed with worksheetchange or other functions that I do not understand. I feel that a lot of the code written is not pretty but the progression towards the link checking is clear and easy to understand. I apologize for the entire thing not looking pretty but I am pretty sure that it will not hurt my code.
BREAKDOWN:
checklinks is run, it opens CheckLinksForm,
Select 2 Columns to show that you are interested in relating two columns and checking for links between. This will call RelateColumns
Relate Columns will ask you for the range of interest(top left and bottom left values), and will output information on them.
Most of my data strings are too long to want to post, so heres a small one that it fails on from one of our competitors
Column A: http://shop.cafepress.com/twilight
Column B: http://www.cafepress.com/Eclipse.455073430
This should return that the first link works, the 2nd link yields a 404 error, and there is a link from the first link to the second link on their website, but it returns that no such link exists. If you check the source code of the website the link is definitely there, so this is a problem.

Sorry for the long post, but this is what I think it takes to help you run the program to test on your end.

Thanks a bunch for helping

'''''''THIS IS ALL WITHIN A MODULE TITLED RelateColumns

EDIT: removed code per request - Moderator
 
Last edited by a moderator:

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello leeple,

Would it be possible for you to either post the workbook or send me a copy? There is simply too much code here for me to spend time trying to make a working test copy.

Sincerely,
Leith Ross
 

leeple

New Member
Joined
Feb 16, 2011
Messages
5
yes of course. I did not know that posting a workbook was an option, I thought it was somehow taboo. Could you send me your email address? I cannot find the "attach file" button.
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello leeple,

I will send you my email address via private message.

Sincerely,
Leith Ross
 

Forum statistics

Threads
1,082,283
Messages
5,364,276
Members
400,787
Latest member
bs04c

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top