I tried seeing what was the problem by making ie.visible(true). It turns out that when I use:
ie.navigate "https://translate.google.com/#" & ilang & "/" & olang & "/" & cell.Value
it doesn't reload the page when it should.
For example, refer to the images:
So it enters the new URL in the address bar but doesn't actually navigate to that URL.
Code is here (Subroutine):
Sub Test()
Dim str As String
str = Translate(Range("B3:B7"), "auto", "hi")
End Sub
Actual Code:
'A function called translate
Public Function Translate(r As Range, ilang As String, olang As String) As String
'Declaring all variables
Dim ie As InternetExplorer
Dim y As Integer
Dim ys As String
Dim urmsg As String
Dim result As String
y = 0
Set ie = New InternetExplorer
ie.Visible = True
For Each cell In r
ie.navigate "https://translate.google.com/#" & ilang & "/" & olang & "/" & cell.Value
Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
y = y + 1
result = ie.document.getElementById("result_box").innerText
Sheets("Sheet1").Range("G" & y).Value = result
Next cell
urmsg = MsgBox(ys & " Translations Executed...", vbOK, "Prompt")
ie.Quit
Translate = " "
End Function
Please tell me what the issue is so that I can solve it. Also, go easy on me if the code is very choppy and has unnecessary lines, I've only studied VBA for a few days.
Thank you.
Related
I am working on a website data extractor. I have two worksheets one for input and other for output, which looks like this..
In the first sheet the cell contains the URL needed to extract data. I am trying this URL
https://www.propertyguru.com.sg/singapore-property-listing/property-for-sale?limit=30&market=residential&property_type_code%5B%5D=4S&property_type=H&freetext=Yishun
I have written this macro..
Sub extractTablesData()
Dim IE As Object, obj As Object
Dim str, e As String
Dim pgf, pgt, pg As Integer
Dim ele, Results As Object
Dim add, size, cno, price, inurl, sp, sp1 As String
Dim isheet, rts As Worksheet
Dim LastRow As Long
Dim pgno As Variant
Set IE = CreateObject("InternetExplorer.Application")
Set isheet = Worksheets("InputSheet")
Set rts = Worksheets("Results")
URL = isheet.Cells(3, 2)
RowCount = 1
rts.Range("A" & RowCount) = "Address"
rts.Range("B" & RowCount) = "Size"
rts.Range("C" & RowCount) = "Contact Number"
rts.Range("D" & RowCount) = "Price"
rts.Range("E" & RowCount) = "Url"
LastRow = rts.Cells(Rows.Count, 2).End(xlUp).Row
'RowCount = LastRow
With IE
.Visible = True
.navigate (URL)
DoEvents
Do While IE.Busy Or IE.readyState <> 4
Loop
'Application.Wait (Now + #12:00:05 AM#)
For Each Results In .document.all
Select Case Results.className
Case "title search-title"
str = Results.innerText
str1 = Split(str, " ")
str = CInt(str1(0))
End Select
If Results.className = "btn btn-main-inverted dropdown-toggle" And InStr(1, Results.Title, " page") > 2 Then
str2 = Results.Title
str1 = Split(str2, " ")
str2 = CInt(str1(0))
End If
Next
If str2 = 0 Then
pgno = CVErr(xlErrDiv0)
Else
pgno = WorksheetFunction.RoundUp(str / str2, 0)
End If
End With
IE.Quit
Set IE = Nothing
UrlS = Split(URL, "?")
Url1 = UrlS(0)
Url2 = "?" & UrlS(1)
For i = 1 To pgno
Set IE = CreateObject("InternetExplorer.Application")
URL = Url1 & "/" & i & Url2
With IE
.Visible = True
.navigate (URL)
DoEvents
Do While IE.Busy Or IE.readyState <> 4
Loop
'Application.Wait (Now + #12:00:08 AM#)
For Each ele In .document.all
Select Case ele.className
Case "listing-img-a"
inurl = ele.href
rts.Cells(LastRow + 1, 5) = inurl
Case "listing-location"
LastRow = LastRow + 1
add = ele.innerText
rts.Cells(LastRow, 1) = add
Case "lst-sizes"
sp = Split(ele.innerText, " ยท")
size = sp(0)
rts.Cells(LastRow, 2) = size
Case "pgicon pgicon-phone js-agent-phone-number" ' btn-tools" 'pgicon pgicon-phone js-agent-phone-number" 'agent-phone-number"
rts.Cells(LastRow, 3) = ele.innerText
Case "listing-price"
price = ele.innerText
rts.Cells(LastRow, 4) = price
End Select
Next
LastRow = rts.Cells(Rows.Count, 2).End(xlUp).Row
rts.Activate
rts.Range("A" & LastRow).Select
End With
IE.Quit
Set IE = Nothing
Application.Wait (Now + #12:00:04 AM#)
Next i
MsgBox "Success"
End Sub
When I run this macro I am getting the error
Type Miss Match
When I debug it highlights the code
For i = 1 To pgno
Set IE = CreateObject("InternetExplorer.Application") URL = Url1 & "/" & i & Url2
With IE .Visible = True .navigate (URL)
I have tried my best to figure it out but could not understand where the problem is. Please help me to make correction..
It is also not getting the whole records on the link. This link contains more than 200 Records as per page is 30 records.
You can rely on implicit conversion and use the following. Assuming all pages do have numbering. You might want to improve error handling. I default to page numbers = 1 if the penultimate li CSS selector fails, otherwise it attempts to get the last page number before the ">"
Refer to my prior answer to your related question which shows you how to more effiently scrape the info off the page.
Sample code to show function being used:
Option Explicit
Public Sub GetListings()
Dim IE As New InternetExplorer, pgno As Long
With IE
.Visible = True
.navigate "https://www.propertyguru.com.sg/singapore-property-listing/property-for-sale?limit=30&market=residential&property_type_code%5B%5D=4S&property_type=H&freetext=Yishun", False
While .Busy Or .readyState < 4: DoEvents: Wend
pgno = GetNumberOfPages(.document)
End With
End Sub
Public Function GetNumberOfPages(ByVal doc As HTMLDocument) As Long
On Error GoTo errhand:
GetNumberOfPages = doc.querySelector(".listing-pagination li:nth-last-child(2)").innerText
Exit Function
errhand:
If Err.Number <> 0 Then GetNumberOfPages = 1
End Function
I want to know if a certain keyword exists in entire website.
How can I do it?
Quick googling suggested this way
"Googling 101)
.. just type your search terms, followed by site:www.website.com
But I am not sure how to test if it returns positive or negative.
Can anyone help?
Something like this also
Function FIND_IN_PAGE(strURL As String, strSearch As String)
Dim pos As Long
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Set ie = New SHDocVw.InternetExplorer
ie.Visible = 1
ie.navigate strURL
Do Until ie.readyState = READYSTATE_COMPLETE And ie.Busy = False
DoEvents
Loop
Set doc = ie.document.DocumentElement
pos = InStr(1, doc.innerText, strSearch)
FIND_IN_PAGE = pos
ie.Quit
Set ie = Nothing
Set doc = Nothing
End Function
Calling like so
FIND_IN_PAGE("http://stackoverflow.com/questions/40848321/how-to-search-for-a-keyword-in-entire-website","entire")
Try this, it basically checks to see if there are any google search results by searching for a keyword or phrase on the site:
Sub Check_Website()
Dim ie As Object
Dim str As String, web As String, URL As String
Dim iResults As Integer
'Create IE object
Set ie = CreateObject("InternetExplorer.Application")
'Set string to search for
str = "hello"
str = Replace(str, " ", "+")
'Set website to search in
web = "www.google.com"
'Create full URL
URL = "https://www.google.co.uk/search?q=" & str & "+site%3A" & web
'Navigate to URL
With ie
.Visible = False
.Navigate URL
Do While .ReadyState <> 4: DoEvents: Loop
End With
'Count results on first page
iResults = ie.Document.getelementsbyclassname("g").Length
'Message box dependent on results
If iResults = 0 Then
MsgBox "No matches were found."
Else
MsgBox "Matches found."
End If
ie.Quit
Set ie = Nothing
End Sub
Google uses the class name of "g" for there search results meaning there will be a maximum of 10 items in the "g" class for the particular search results page, if no results are shown there is no "g" class which means there are no items to be counted.
I have been trying to get this code to work for workflow efficiency purposes, but I cannot seem to make it function correctly.
Steps:
1. Login to Amazon Seller
Use order numbers in column A and place them in searchbox to search
Search for element innerText of "Estimated Delivery:" and scrape information into column B adjacent the order number
Move onto the next order number and repeat process until order number column is empty.
The webpage code (what I'm trying to obtain is highlighted):
Option Explicit
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub MyAmazonSellereEDD()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim oSignInLink As HTMLLinkElement
Dim oInputEmail As HTMLInputElement
Dim oInputPassword As HTMLInputElement
Dim oInputSignInButton As HTMLInputButtonElement
'InputSearchOrder will be the destination for order numbers taken from the workbook
Dim InputSearchOrder As HTMLInputElement
Dim InputSearchButton As HTMLInputButtonElement
Dim IE As InternetExplorer
Dim AAOrder As Workbook
Dim AAws As Worksheet
Dim AAws2 As Worksheet
Dim R As Range
Dim x As Integer
Dim i As Long
Dim ar As Variant
Dim elems As IHTMLElementCollection
Dim TDelement As HTMLTableCell
Dim ExcludWords() As Variant, a As Range, b As Long, LR As Long
ExcludWords = Array("Estimated Delivery:")
MyURL = "https://sellercentral.amazon.com/gp/homepage.html"
Set IE = New InternetExplorer
' Open the browser and navigate.
With IE
.Silent = True
.navigate MyURL
.Visible = True
Do
DoEvents
Loop Until .readyState = READYSTATE_COMPLETE
End With
' Get the html document.
Set HTMLDoc = IE.document
With HTMLDoc
.all.Item("username").Value = "blankityblank#blank.net"
.all.Item("password").Value = "*********"
.all.Item("sign-in-button").Click
End With
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:08"))
'Set AAOrder = Application.Workbooks.Open("Z:\Automation Anywhere\5 Automated Tracking Imports\Amazon Prime\PrimeOrdersWithNoFulfillment.csv")
'Set AAws = AAOrder.Worksheets("PrimeOrdersWithNoFulfillment")
x = 2
'Do Until Range("A" & x) = ""
If Range("B" & x).Value = "" Then
'If AAws.Range("B" & x).Value = "" Then
'x = x + 1
Do Until Range("A" & x) = ""
Set InputSearchOrder = HTMLDoc.getElementById("sc-search-field")
InputSearchOrder.Value = Range("A" & x)
Set InputSearchButton = HTMLDoc.getElementsByClassName("sc-search-button")(0)
InputSearchButton.Click
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:05"))
Set elems = HTMLDoc.getElementsByTagName("td")
'ExcludWords = Array("Package Weight:", "Tracking ID:", "Ship Date:", "Carrier:", "Shipping Service:")
i = 2
For Each TDelement In elems
If TDelement.className = "data-display-field" And InStr(TDelement.innerText, "Estimated Delivery:") Then
Range("B" & x).Value = TDelement.innerText
i = i + 1
End If
Next
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
Set a = Cells(i, "B")
For b = 0 To UBound(ExcludWords)
a.Formula = Replace((a.Formula), ExcludWords(b), "")
Next b
Next i
'End If
x = x + 1
Loop
'Loop
End If
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
MsgBox ("Process is done! :)")
End Sub
My issue is that when it scrapes the data, the words "Estimated Delivery:" and the actual estimated delivery date it is supposed to scrape are separate, but still should be included in the output data in column B. What it's doing is finding and inserting only "Estimated Delivery:" and then using the code, it trims those characters as instructed. The space is still blank after that. I'm not sure what the issue is.
The TDelement you pick up in the following part of code only includes "Estimated Delivery:" in its innerText, the part with the date is actually a separate TDelement:
For Each TDelement In elems
If TDelement.className = "data-display-field" And InStr(TDelement.innerText, "Estimated Delivery:") Then
Range("B" & x).Value = TDelement.innerText
i = i + 1
End If
Next
As there is not any unique information in the html code (e.g. id, name etc.) to use to reference the TDelement that contains the date you could use the reference you already have in conjunction with NextSibling so that you get the element after the one that contains the text "Estimated Delivery:". Perhaps try this (unable to test anything at the moment but should work):
For Each TDelement In elems
If TDelement.className = "data-display-field" And InStr(TDelement.innerText, "Estimated Delivery:") Then
Range("B" & x).value = TDelement.NextSibling.innerText
i = i + 1
End If
Next
I have a list of local webpages (over 9000) which I want to parse with Excel VBA.
I use Office 2013 with IE 11 on:
a Windows 7 Enterprise Pro x64, 16 GB RAM, i7 - Processor but also on
a Windows 8.1 Enterprise x64, 12 GB RAM, i7 - Processor
The problem on both machiens is that after successfuly parsing about 70-80 pages, the programm suddenly fails to load the next webpage into IE. It gets "stuck" so to say (see comment in the code below). If I reset the programm, then it can parse without problen again about 70-80 profiles after "failing" again.
[EDIT: I'm sorry, I posted by mistake the wrong code. Here is the corrected
version]
Here is a part of the code:
<!-- language: lang-HTML -->
Sub ImportFromWebpage()
'GLOBAL VARIABLES
Dim html As HTMLDocument
Dim CurrentRowPosition, ProfileNumber, TotalProfiles As Integer
Dim TempProfileID As String
Dim profileRange, posCounter, currentProfile As Range
Set profileRange = Worksheets("List_of_Files").Range("B2:B20000")
ProfileNumber = 519
CurrentRowPosition = 520
TotalProfiles = Application.WorksheetFunction.CountA(profileRange)
'MsgBox "TotalProfiles = " & TotalProfiles
'VARIABLES NEEDED FOR PARSING HERE
'ELEMENTS
Dim firstIHTMLElmt, secondIHTMLElmt, thirdIHTMLElmt As IHTMLElement
Dim firstTempIHTMLElmt, secondTempIHTMLElmt, thirdTempIHTMLElmt, fourthTempIHTMLElmt, fiftTempIHTMLElmt As IHTMLElement
'COLLECTIONS
Dim firstIHTMLEColl, secondIHTMLEColl, thirdIHTMLEColl As IHTMLElementCollection
Dim firstTempIHTMLEColl, secondTempIHTMLEColl, thirdTempIHTMLEColl, fourthTempIHTMLEColl, fifthTempIHTMLEColl As IHTMLElementCollection
Dim ie As InternetExplorerMedium
Set ie = New InternetExplorerMedium
ie.Visible = False
'FROM HERE LOOPING
For startNumber = 1 To TotalProfiles
Application.StatusBar = "Loading profile " & ProfileNumber & " from a total of " & TotalProfiles & " profiles"
'Set currentProfile = Worksheets("List_of_Files").Range("J" & CurrentRowPosition) // OLD
Set currentProfile = Worksheets("List_of_Files").Range("B" & CurrentRowPosition)
ie.navigate currentProfile
Application.StatusBar = "Loading profile: " & ProfileNumber & "; file location: " & currentProfile
Do While ie.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop
Application.StatusBar = "Storing " & currentProfile & " information into HTMLElement"
Set html = ie.document
Set ie = Nothing
[code, code, code, code ...]
Application.Wait (Now + TimeValue("0:00:02"))
Next startNumber
Set html = Nothing
ie.Quit
Set ie = Nothing
MsgBox "Done parsing all profiles!"
End Sub
Here is a screenshot from the Windows 8.1 task manager AFTER failing to load:
Dose someone have any clue about why this is happening? Not only on one machiene, but on both.
I an not very experience with programming and even less with VBA so any help would be much appreciated.
This solution proved to be a good one in my case. Don't know whether this is the best solution but it work very good for me.
put IE declaration before the loop to initiate an instance of Internet Explorer; this is the only instance which will be used (the link is just going to be refreshed within this instance)
set html = Nothing within the loop
set ie = Nothing outside of the loop, so that only the link may be refreshed without restarting IE
ie.Quit only after parsing all >9000 webpages (so outside of the loop)
Hope it helps others with the same problem.
Sub ImportFromWebpage()
'GLOBAL VARIABLES
Dim html As HTMLDocument
Dim CurrentRowPosition, ProfileNumber, TotalProfiles As Integer
Dim TempProfileID As String
Dim profileRange, posCounter, currentProfile As Range
Set profileRange = Worksheets("List_of_Files").Range("B2:B20000")
ProfileNumber = 1
CurrentRowPosition = 2
TotalProfiles = Application.WorksheetFunction.CountA(profileRange)
'MsgBox "TotalProfiles = " & TotalProfiles
Dim ie As InternetExplorerMedium
Set ie = New InternetExplorerMedium
ie.Visible = False
'FROM HERE LOOPING
For startNumber = 1 To TotalProfiles
Application.StatusBar = "Loading profile " & ProfileNumber & " from a total of " & TotalProfiles & " profiles"
'Set currentProfile = Worksheets("List_of_Files").Range("J" & CurrentRowPosition) // OLD
Set currentProfile = Worksheets("List_of_Files").Range("B" & CurrentRowPosition)
ie.navigate currentProfile
Application.StatusBar = "Loading profile: " & ProfileNumber & "; file location: " & currentProfile
Do While ie.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop
Application.StatusBar = "Storing " & currentProfile & " information into HTMLElement"
Set html = ie.document
[code, code, code, code ...]
Set html = Nothing
Application.Wait (Now + TimeValue("0:00:02"))
Next startNumber
Set ie = Nothing
ie.Quit
MsgBox "Done parsing all profiles!"
End Sub
I have multiple urls stored in Excel sheet. I want to Get data reside within particular div tag. For One Website it works fine
Sub Cityline()
Dim IE As Object
Set IE = CreateObject("Internetexplorer.application")
IE.Visible = True
IE.navigate "http://Someurl.com/bla/bla/bla"
Do While IE.busy
DoEvents
Loop
Do
DoEvents
Dim Doc As Object
Set Doc = IE.Document
Dim workout As String
workout = Doc.getElementsByClassName("CLASS_NAME_OF_DATA")(0).innertext
Range("A2") = workout
Loop
End Sub
I used Below code for loop Through all urls but its not working
Sub GetData()
Dim oHtm As Object: Set oHtm = CreateObject("HTMLFile")
Dim req As Object: Set req = CreateObject("msxml2.xmlhttp")
Dim oRow As Object
Dim oCell As Range
Dim url As String
Dim y As Long, x As Long
x = 1
For Each oCell In Sheets("sheet1").Range("A2:A340")
req.Open "GET", oCell.Offset(, 1).Value, False
req.send
With oHtm
.body.innerhtml = req.responsetext
With .getelementsbytagname("table")(1)
With Sheets(1)
.Cells(x, 1).Value = oCell.Offset(, -1).Value
.Cells(x, 2).Value = oCell.Value
End With
y = 3
For Each oRow In .Rows
Sheets(1).Cells(x, y).Value = oRow.Cells(1).innertext
y = y + 1
Next oRow
End With
End With
x = x + 1
Next oCell
End Sub
But its not working
can any one suggest me where i went wrong ?
I used Fetching Data from multiple URLs but it doesn't works for me.
Please guide me how to get data from all urls at a Time
I'm new to SO, so apologies to the mods if this should be in comments (I couldn't get it to fit).
I agree with Silver's comments, but I thought I'd suggest a different approach that might help. If you have URLs in a column of cells, you could create a custom VBA function that will extract the relevant data out of the HTML. Just use this function in the cells to the right of your URL to return the relevant data from the HTML. An example is this:
Public Function GetHTMLData(SiteURL As String, FieldSearch As String) As String
Dim IE As Object
Dim BodyHTML As String
Dim FieldStart As Integer
Dim FieldEnd As Integer
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate SiteURL
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
BodyHTML = IIf(StrComp(.Document.Title, "Cannot find server", vbTextCompare) = 0, _
vbNullString, .Document.body.innerhtml)
FieldStart = InStr(1, BodyHTML, FieldSearch) + Len(FieldSearch) + 12
FieldEnd = InStr(FieldStart, BodyHTML, "<")
GetHTMLData = Mid(BodyHTML, FieldStart, FieldEnd - FieldStart)
.Quit
End With
Set IE = Nothing
End Function
The function above has 2 input parameters: the URL and a string that will be searched for within the HTML. It will then return a string from within the HTML, starting from 12 characters after the searched parameter and ending at the following '<' within the HTML.
Hope that helps.