I have looked at over 50 posts through various forums, working through at least 5-6 examples, and continue to get an error.
Of those one was: Pull Web Page Into Worksheet
I would be happy if any web browser worked, so if you have an existing code that would make your response easier with a preferred browser, don't let my first attempts with IE deter you.
The main barrier that I predict is that it has multiple pause points and differing url's for them before the content I want shows up. It's an intranet site but I was able to get it to still pull in a cell from the final site but not .
URL 1 is an intranet search engine, enter value into input box, click and it sends you to URL 2 (which has search string added on) but is just progress bars, URL 3 (with unique tail each search) is now loaded with the table (or whole page is fine) that I need copied.
They follow this formatting:
URL 1 --- https://abc.XYZ.org/.../v12/
URL 2 --- https://abc.XYZ.org/.../cgi/..…engines=Bing&flags=genius
URL 3 --- https://abc.XYZ.org/.../v12//main.html?path=110746_29570
So I've attempted where I control IE and enter in the input box and click as well as where I just create the URL 2 as a search string. I can get URL 3 to come up as expected but idk if it's because it's a new URL (not new window) it's not seeing it as the active object to copy from?
I've tried so many things outside of code as well, clearing cache/cookies, thinking maybe I don't have the right reference library I am now up to this mess...
I have reviewed concepts of capturing a url from an existing window, copying by tags and class, etc. But I keep getting errors like:
Method 'Busy' of object 'IWebBrowser2' failed, or if I lead it with Document then that is the method it stops on.
Do While objIE.Document.ReadyState <> 4 Or objIE.Busy = True: DoEvents: Loop
Do Until objIE.Document.ReadyState = 4: DoEvents: Loop
Automation error
Unspecificed error
I cannot add extensions to Chrome as they are blocked by admin as well as cannot install things or I'd attempt to get a macro recorder for my browser.
Thank you for all your help.
I'll paste code here, but since I can't give you the site, idk how much use it will be other than to see some of the different approaches I tried. Here's a blank workbook with the code inside: CopyWebContent.xlsm
This site may be an ok surrogate for URL 3: http://disclosure.bursamalaysi…Access/viewHtml?e=2891609
Option Explicit
Private Sub IEHandles()
Dim shl, wins, i, win, result
Set shl = CreateObject("Shell.Application")
Set wins = shl.Windows
For i = 0 To wins.Count - 1
Set win = wins.Item(i)
result = result & win.Hwnd & vbCrLf
Next
MsgBox result, vbInformation, "IE Handles"
End Sub
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer, clipboard As Object
Dim ShortSearchStr As String
ShortSearchStr = "https://iris1..../v16/"
With IE
.Visible = True
.Navigate ShortSearchStr
While IE.Busy Or IE.ReadyState < 4: DoEvents: Wend
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With .Document.getElementById("bm_ann_detail_iframe").contentDocument
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = .getElementsByClassName("company_name")(0).innerText
clipboard.SetText .getElementsByTagName("table")(1).outerHTML
clipboard.PutInClipboard
End With
ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).PasteSpecial
.Quit
End With
End Sub
Public Sub GetTable() 'most promising
Dim sResponse As String, html As HTMLDocument, clipboard As Object
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://iris1/..../main.html?path=90717_85975", False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
html.body.innerHTML = sResponse
With html
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = .querySelector(".naught").innerText
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText .querySelector(".naught").outerHTML
ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Select
clipboard.PutInClipboard
End With
ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).PasteSpecial
End Sub
Sub tester() ' to go with Function GetIE
Dim IE As Object
Set IE = GetIE("http://www.aarp.org/")
If Not IE Is Nothing Then
IE.ExecWB 17, 0 '// SelectAll
IE.ExecWB 12, 2 '// Copy selection
ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
Range("A1").Select
IE.Quit
End If
End Sub
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
sURL = ""
On Error Resume Next 'because may not have a "document" property
'Check the URL and if it's the one you want then
' assign the window object to the return value and exit the loop
sURL = o.Document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function
Private Sub ToolSubmit()
Dim objIE As Object
Dim ele As Object
Dim y As Integer
Dim aEle As HTMLLinkElement
Dim result As String
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True 'False?
'' objIE.Navigate SearchString 'Navigate2?
objIE.Navigate2 ShortSearchStr
' Wait while IE loading
Do While objIE.Document.ReadyState <> 4 Or objIE.Busy = True: DoEvents: Loop
' Do Until objIE.Document.ReadyState = 4: DoEvents: Loop
objIE.Document.getElementById("search_term").Value = _
Sheets("Sheet1").Range("B2").Value
objIE.Document.getElementById("search_term").Value = _
Sheets("Sheet1").Range("B3").Value
objIE.Document.getElementById("submit").Click
y = 10
For Each aEle In objIE.Document.getElementsByClassName("zebra")
'...get the href link and print it to the sheet in col C, row y
result = aEle
Sheets("Sheet1").Range("B8").Value = result
'...get the text within the element and print it to the sheet in col D
Sheets("Sheet1").Range("A" & y).Value = aEle.innerText
Debug.Print aEle.innerText
' 'look at all the 'tr' elements in the 'table' with id 'linkResultTable',
' 'and evaluate each, one at a time, using 'ele' variable
' For Each ele In objIE.Document.getElementById("linkResultTable").getElementsByTagName("tr")
' 'show the text content of 'tr' element being looked at
' Debug.Print ele.textContent
' 'each 'tr' (table row) element contains 10 children ('td') elements
' 'put text of 1st 'td' in col A
' Sheets("Sheet1").Range("A" & y).Value = ele.Children(0).textContent
' Sheets("Sheet1").Range("B" & y).Value = ele.Children(1).textContent
'
'increment row counter by 1
y = y + 1
Next
''''
' Dim MainHTML As Variant
' MainHTML = IE.Document.body.innerText
' MainHTML = Replace(MainHTML, Chr(10), Chr(13))
' MainHTML = Split(MainHTML, Chr(13))
'
'
' Sheets("Sheet1").Range("A9").Resize(UBound(MainHTML)) = Application.Transpose(MainHTML)
''''
'Cleanup
objIE.Quit
Set objIE = Nothing
End Sub