Extracting metatags from a web page and inserting them in a worksheet.

J

John Wirt

Is it possible towrite a web query that will extract the metatags from a web
page and inert them in the active worksheet? How?

The metatag field of a web page is in the header and not in a table.

Suppose the metatag specification in the web page is:

<meta http-equiv="keywords" content="Southeast,full-day,half-day,minority
enrollment,free or reduced-price lunch,school lunch,region,early
childhood,poverty level,preK">

The problem is how can the list of keyword be extracted and inserted in a
worksheet?

The actual URL for this metatag is:
http://nces.ed.gov/programs/coe/2004/section1/indicator02.asp

Thank you.

John Wirt
 
T

TroyW

John,

Run the Test1 subroutine and it should return the list of keywords. A
browser window will appear and once the page is finished loading, the meta
tag information is captured. Then the browser window is closed and a
message box appears with the extracted meta tag info. If you don't want the
browser window to be visible, change the ".Visible = True" line to ".Visible
= False".

Does the code do what you want?

Troy


Sub Test1()
Dim sURL As String
Dim sBeg As String
Dim sEnd As String
Dim sText As String

sURL = "http://nces.ed.gov/programs/coe/2004/section1/indicator02.asp"
sBeg = "keywords"
sEnd = ">"

sText = fcnIEgetMeta(sURL, sBeg, sEnd)
MsgBox sText
'Sheet1.Range("A1").Value = sText

End Sub

Function fcnIEgetMeta(sURL As String, _
sBeg As String, sEnd As String) As String

Dim oIE As Object
Dim sHTML As String
Dim lngBeg As Long
Dim lngEnd As Long

Set oIE = CreateObject("InternetExplorer.Application")
With oIE
.Navigate sURL
.Visible = True
'''Loop until the content is loaded.
Do Until Not .Busy And .ReadyState = 4
DoEvents
Loop
'''Capture the HTML text in the <HEAD> section.
sHTML = .Document.Body.parentElement.innerHTML
End With

'''Close the browser session.
oIE.Quit
Set oIE = Nothing

'MsgBox sHTML

'''Find the Meta Tag Information.
lngBeg = InStr(1, sHTML, sBeg, vbTextCompare)
If lngBeg Then
lngBeg = lngBeg + Len(sBeg)
lngEnd = InStr(lngBeg, sHTML, sEnd, vbTextCompare)
If lngEnd Then
lngEnd = lngEnd - 1
fcnIEgetMeta = Mid$(sHTML, lngBeg, _
lngEnd - lngBeg + 1)
End If
End If

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top