I need to extract specific data from a web page and paste those in an excel sheet. The data is the value of title="" in a web page. For example: title="915-526-6305", I need to extract 915-526-6305. Is there a way to do this or help me get started?
I need to extract specific data from a web page and paste those in an excel sheet. The data is the value of title="" in a web page. For example: title="915-526-6305", I need to extract 915-526-6305. Is there a way to do this or help me get started?
It is probably not easy to help You, without page with this information.
it is up to You.
Web Page Code :Originally Posted by hardlife
<html> <head> <title>915-526-6305</title> </head. etc.
me is not skilled in html source code, please if You want me - to help, post web page where is this information, me will try my best to help You.
with best regards, Pavel
Based on Vladimir's code here
[vba]
Option Explicit
Option Compare Text
Sub test()
MsgBox GetTitle("http://www.vbaexpress.com/forum/forumdisplay.php?f=17", "Title")
End Sub
Function GetTitle(WebPage As String, Tag As String)
Dim t, Tag2 As String, EndTag As String
Dim oHttp As Object, txt$, i&, j&
'Adjust this to suit
Tag2 = Tag & "=" & Chr(34)
EndTag = Chr(34)
'*************************
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
If oHttp Is Nothing Then MsgBox "MSXML2.XMLHTTP not found", 16, "Error": Exit Function
On Error GoTo 0
With oHttp
.Open "GET", WebPage, False
.Send
txt = .responseText
i = InStr(1, txt, Tag2, 1)
If i = 0 Then
GetTitle = Tag & " not found"
Else
t = Split(txt, Tag2)(1)
GetTitle = Split(t, EndTag)(0)
End If
End With
Set oHttp = Nothing
End Function
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Great! Thank u guys for your help!
Expand on this...
I used the code above to get the data that I need. It works beautifully. If I wanted to take this step further I will need help. I have a spreadsheet with a few thousand URL's. I would like the final script to read the URL in column B then automatically parse the webpage "title", "description", and "Keywords" in the adjacent columns on the same line as each respective url. Does this make sense? Any help would be greatly appreciated.
Thanks!
Mike
Welcome to VBAX
Can you post a workbook with two or three web pages from your selection.
Use Manage attachments in the Go Advanced reply section.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Is it ok if I give you another sheet that has the same layout but different data? Here is an example of the layout, the other contains data from a different site but in the same layout and is obviously a lot smaller than the workbook that I am working with. If not, let me know and perhaps I can e mail you the workbook. I would rather not post it on the interwebz. Thanks in advance for your help!!
There is another module in that file which allows me to select the group of URL's and when i run the script, it places the link address in the adjacent column.
Give this a try
Select the URLs first then run the code
[VBA]Option Explicit
Option Compare Text
Sub test()
Dim t, Tag As String, Tag2 As String, EndTag As String, GetTitle As String
Dim oHttp As Object, txt$, i&, j&, x&
Dim arr
Dim cel As Range
arr = Array("title", "description", "keywords")
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
If oHttp Is Nothing Then MsgBox "MSXML2.XMLHTTP not found", 16, "Error": Exit Sub
On Error GoTo 0
For Each cel In Selection
With oHttp
.Open "GET", Cells(cel.Row, 2), False
.Send
txt = .responseText
For x = 0 To 2
Tag = arr(x)
'Adjust this to suit
Tag2 = Tag & Chr(34) & " content="
EndTag = Chr(34)
'*************************
i = InStr(1, txt, Tag2, 1)
If i = 0 Then
GetTitle = "not found"
Else
t = Split(txt, Tag2)(1)
GetTitle = Split(t, EndTag)(1)
End If
Cells(cel.Row, 3).Offset(, x) = GetTitle
Next
End With
Next
Set oHttp = Nothing
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
You are darn brilliant!!! Works for description and keywords however, it is returning "not found" for title. Other than that, worked brilliantly. Fast, and lean!
OK, I just ran that code on the spreadsheet that I gave you and it worked fine. Like I said, I would prefer to not post the actual workbook that I am working on. Is there another way for me to get that workbook to you?
[vba]
Option Explicit
Option Compare Text
Sub test()
Dim t, Tag As String, tag2 As String, EndTag As String
Dim oHttp As Object, txt$, i&, j&, x&
Dim arr
Dim cel As Range
arr = Array("head", "description", "keywords")
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
If oHttp Is Nothing Then MsgBox "MSXML2.XMLHTTP not found", 16, "Error": Exit Sub
On Error GoTo 0
For Each cel In Selection
If cel <> "" Then
With oHttp
.Open "GET", Cells(cel.Row, 2), False
.Send
txt = .responseText
For x = 0 To 2
Tag = arr(x)
'Adjust this to suit
If Tag = "head" Then
tag2 = "<Title>"
Cells(cel.Row, 3).Offset(, x) = GetTitle(txt, tag2, "<", 0)
Else
tag2 = Tag & Chr(34) & " content="
Cells(cel.Row, 3).Offset(, x) = GetTitle(txt, tag2, Chr(34), 1)
End If
Next
End With
End If
Next
Set oHttp = Nothing
End Sub
Function GetTitle(txt, tag2, EndTag, Bit)
Dim i As Long, t
i = InStr(1, txt, tag2, 1)
If i = 0 Then
GetTitle = "not found"
Else
t = Split(txt, tag2)(1)
GetTitle = Trim(Split(t, EndTag)(Bit))
End If
End Function
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Thank you very much kind sir. Works perfectly. You just saved me having to manually retrieve and enter that data on not only this, but 6-7 more workbooks just like this one.
Hi all,
This code looks like exactly what I need as well but when I run it, I get the Invalid procedure call or argument error.
I've researched the error and it suggests that maybe I haven't selected the input range but I do so I'm confused.
What I'm doing exactly is selecting a range of URL's that I've entered and then going into the vba code and hitting the 'run' button.
That's when I get the error.
What am I doing wrong?
Any help would be much appreciated.
Thanks!
Invalid procedure call or agument error when I run this?
Hi all (not sure if I replied to this post properly the first time so am trying again),
This code looks like exactly what I need as well but when I run it, I get the Invalid procedure call or argument error.
I've researched the error and it suggests that maybe I haven't selected the input range but I do so I'm confused.
What I'm doing exactly is selecting a range of URL's that I've entered and then going into the vba code and hitting the 'run' button.
That's when I get the error.
What am I doing wrong?
Any help would be much appreciated.
Thanks!
Im curious about this. So this code can actually fetch specific data on a webpage? not only in the web source but also in webpage body?
worked for me...
- downloaded the file form post#9,
- copied the codes from post#14 to a standard module,
- select the url's in column B,
- run the code.
PLS DO NOT PM; OPEN A THREAD INSTEAD!!!
1) Posting Code
[CODE]PasteYourCodeHere[/CODE]
(or paste your code, select it, click # button)
2) Uploading File(s)
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.
3) Testing the Codes
always back up your files before testing the codes.
4) Marking the Thread as Solved
from Thread Tools (on the top right corner, above the first message)
Yes I also confirmed this works. But my question is, is this can also grab table content in the webpage. I know web query but its a hassle re entering the URL each time.
Posting Permissions
Reply With Quote
