PDA

View Full Version : Internet explorer automation/vba



efz
03-13-2012, 04:56 PM
Hello guys,

As i am experimenting with getting data from the Web into excel i have made this following code that basically you put Forum Thread IDs in column A and in return you get title of the thread and Date in Column B & C.

As I got another project that I am working on I would like to know if this code below is possible to get transformed using Internet Explorer object automation instead as this website of the project I got gives me "access is denied" error since it doesnt allow XMLHTTPRequests or if there is any other way that i dont know that "masks" the XMLHTTPRequest

Thank you in advance

Private Sub CommandButton1_Click()
Const qtag = "<title>"
Dim Rng As Range, x As Range, oHttp As Object, txt$, i&, j&
Set Rng = Range("A2", Cells(Rows.Count, 1).End(xlUp))

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

With oHttp
For Each x In Rng
.Open "GET", "http://www.vbaexpress.com/forum/showthread.php?t=" & x.Value, False
.Send
txt = .responseText
i = InStr(1, txt, qtag, 1)
If i = 0 Then
x.Offset(, 1).Value = " "
Else
i = i + 7
j = InStr(i, txt, " - VBA Express Forum", 0)
x.Offset(, 1) = Replace(Mid(txt, i, j - i), " ", "")
End If
i = InStr(1, txt, "statusicon", 1)
If i = 0 Then
x.Offset(, 2).Value = " "
Else
i = i + 55
j = InStr(i, txt, "M", 0)
x.Offset(, 2) = Replace(Mid(txt, i, j - i), "", "")
End If
i = InStr(1, txt, "member.php?u=", 1)
If i = 0 Then
x.Offset(, 3).Value = " "
Else
i = i + 23
j = InStr(i, txt, "</b>", 0)
x.Offset(, 3) = Replace(Mid(txt, i, j - i), "", "")
End If
Next
End With
Set oHttp = Nothing
End Sub

Crocus Crow
03-14-2012, 08:50 AM
What is the URL? Without knowing the URL it's difficult to give you specific help.

How do you know the site doesn't allow XMLhttp requests? Try a POST request instead of GET. Try setting request headers (setRequestHeader) before the Send.

Use the HTML object library to parse the response rather than string functions.

IE automation would be:
Dim IE As InternetExplorer
Set IE = New InternetExplorer
IE.Navigate "http://www.theurl.com Search the terms mentioned if you want more info.

efz
03-14-2012, 01:31 PM
Thanks a lot Crocus Crow for your help i managed to solve it with setRequestHeader user-agent Firefox.