I am importing google alerts into my excel worksheet , what I am trying to do is only use the google translate code I have if the text is not in English. As the code is very slow. And I import upto 1000 rows of text. The majority of those are already in English. But at present my code translates every row.
Public Sub Translate()
Const MAX_WAIT_SEC As Long = 5
Dim IE As New InternetExplorer
Dim t As Date
Dim ws As Worksheet
Dim ftext As String
Dim x
Dim y As Long
Dim translation As Object
Dim translationText As String
y = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Set ws = ThisWorkbook.Worksheets("Google_Notifications")
For x = 1 To y
With IE
.Visible = False
.Navigate "https://translate.google.com/#view=home&op=translate&sl=auto&tl=en"
While .Busy Or .ReadyState < 4: DoEvents: Wend
ftext = Sheet1.Range("C" & x).Value
.Document.querySelector("#source").Value = ftext
While .Busy Or .ReadyState < 4: DoEvents: Wend
t = Timer
Do
On Error Resume Next
Set translation = .Document.querySelector(".tlid-translation.translation")
translationText = translation.textContent
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While translationText = vbNullString
Sheet1.Range("C" & x).Value = translationText
Sheet1.Range("E" & x).Value = "Translated"
.Quit
Set IE = Nothing
Set translation = Nothing
translationText = ""
End With
Next x
End Sub
Related
I have used the below vba code to extract website link from
https://www.bursamalaysia.com/market_information/announcements/company_announcement?keyword=&cat=FA%2CFRCO&sub_type=&company=&mkt=&alph=&sec=&subsec=&dt_ht=23%2F04%2F2020&dt_lt=07%2F05%2F2020#/?category=all
into excel spreadsheet.
But it seem like having some problems over here, there is nothing shown up in my spreadsheet. Appreciate if anybody can point out my mistake here.
Below is the list of website link that I wish to extract it into excel spreadsheet.
Sub ScrapLink()
Dim p As Integer
Application.ScreenUpdating = False
p = InputBox("Please insert page number")
Application.ScreenUpdating = False
On Error GoTo ErrorHandler:
Worksheets("results").Cells(1, 1).Value = Worksheets("sheet1").Cells(1, 1).Value
For u = 2 To p
Worksheets("results").Cells(u, 1).Value = Worksheets("sheet1").Cells(1, 1).Value & "&page=" & u
Application.DisplayAlerts = False
Application.DisplayAlerts = True
ErrorHandler:
Application.ScreenUpdating = True
Next u
Dim IE As New InternetExplorer, html As HTMLDocument
Dim x As Long
Application.ScreenUpdating = False
x = WorksheetFunction.CountA(Worksheets("results").Range("A1:A1000"))
With IE
For u = 1 To x
IE.Visible = True
IE.Navigate Worksheets("results").Cells(u, 1).Value
While .Busy Or .ReadyState < 4: DoEvents: Wend
Application.Wait Now + TimeSerial(0, 0, 1)
Application.StatusBar = "Trying to go to website"
DoEvents
Dim links As Object, i As Long
Set links = .Document.querySelectorAll("#bm_ajax_container
[href^='/market_information/announcements/company_announcement/']")
For i = 1 To links.Length
With ThisWorkbook.Worksheets("Sheet1")
Range("A" & rows.count).End(xlUp).Offset(1).Value = links.item(i - 1)
End With
Next i
Next u
.Quit
End With
Worksheets("results").Range("a1:a1000").Clear
End Sub
Try
For i = 0 To links.Length -1
and
Range("A" & rows.count).End(xlUp).Offset(1).Value = links.item(i ).href
assuming correct selector. nodeLists are 0 based.
I'm using Excel VBA to launch an IE browser tab based on the URL in each of the rows in column D. Then the relevant HTML code is extracted based on pre-defined classes and populated in columns A - C.
Pretty sure I missed a step. The process stops at D2 and does not proceed to extract HTML from the next URLs (in cells D3, D4, etc).
Thanks in advance for any suggestions!
Sub useClassnames()
Dim element As IHTMLElement
Dim elements As IHTMLElementCollection
Dim IE As InternetExplorer
Dim html As HTMLDocument
Dim shellWins As New ShellWindows
Dim IE_TabURL As String
Dim intRowPosition As Integer
Set IE = New InternetExplorer
IE.Visible = False
intRowPosition = 2
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate Sheet1.Range("D" & intRowPosition)
While IE.Busy
DoEvents
Wend
intRowPosition = intRowPosition + 1
While Sheet1.Range("D" & intRowPosition) <> vbNullString
IE.navigate Sheet1.Range("D" & intRowPosition), CLng(2048)
While IE.Busy
DoEvents
Wend
intRowPosition = intRowPosition + 1
Wend
Do While IE.readyState <> READYSTATE_COMPLETE
Application.StatusBar = "Loading Web page…"
DoEvents
Loop
Set html = IE.document
Set elements = html.getElementsByClassName("container-bs")
Dim count As Long
Dim erow As Long
count = 0
For Each element In elements
If element.className = "container-bs" Then
erow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1) = html.getElementsByClassName("pull-left")(count + 1).innerHTML
Cells(erow, 2) = html.getElementsByClassName("description")(count).innerHTML
Cells(erow, 3) = html.getElementsByClassName("related-articles")(count).innerHTML
count = count + 1
End If
Next element
Range("A2:C2000").Select
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 36
End Sub
Your lines
Set html = IE.document
Set elements = html.getElementsByClassName("container-bs")
etc happen after the While loop. It needs to be inside.
Your If statement:
If element.className = "container-bs"
should be redundant as you are already looping over a collection of that classname; so I have removed this.
You are not working off element in the loop, so essentially you are using it to control your incremented counter variable. This suggests you can use a better coding strategy for retrieving the items of interest.
Always state the parent worksheet and don't rely on implicit Activesheet references - that is bug prone.
I would expect a structure more like as follows (I cannot account for refactoring to remove element)
Option Explicit
Public Sub UseClassnames()
Dim element As IHTMLElement, elements As IHTMLElementCollection, ie As InternetExplorer
Dim html As HTMLDocument, intRowPosition As Long
intRowPosition = 2
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
While Sheet1.Range("D" & intRowPosition) <> vbNullString
If intRowPosition = 2 Then
ie.navigate Sheet1.Range("D" & intRowPosition)
Else
ie.navigate Sheet1.Range("D" & intRowPosition), CLng(2048)
End If
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Set html = ie.document
Set elements = html.getElementsByClassName("container-bs")
Dim count As Long, erow As Long
count = 0
For Each element In elements
erow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
With Sheet1
.Cells(erow, 1) = html.getElementsByClassName("pull-left")(count + 1).innerHTML
.Cells(erow, 2) = html.getElementsByClassName("description")(count).innerHTML
.Cells(erow, 3) = html.getElementsByClassName("related-articles")(count).innerHTML
End With
count = count + 1
Next element
intRowPosition = intRowPosition + 1
Wend
With Sheet1
.Range("A2:C2000").Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("B:B").ColumnWidth = 36
End With
End Sub
I'm dealing with a problem that's been dealt this before, but not in this situation.
I'm pulling addresses from the USPS website using VBA. When I place in my cell "ele.innertext" I get all of the innertext within the class, but VBA won't let me isolate the innertext to the item level - ele.item(1).innertext, for example, give me the above error. Do you know why?
My browser is IE11.
Relevant HTML:
<div id="zipByAddressDiv" class="industry-detail">Loading...</div>
<!-- start Handlebars template -->
<script id="zipByAddressTemplate" type="text/x-handlebars-template">
<ul class="list-group industry-detail">
{{#each addressList}}
<li class="list-group-item paginate">
<div class="zipcode-result-address">
<p>{{companyName}}</p>
<p>{{addressLine1}}</p>
<p>{{city}} {{state}} <strong>{{zip5}}-{{zip4}}</strong></p>
VBA:
Sub USPS()
Dim eRow As Long
Dim ele As Object
Dim objie As Object
Dim wscript As Object
Dim test As String
Dim testarray() As String
'Dim goods As Object
Dim r As Integer
Dim x As Long: x = 0
Dim vFacility As Variant
Dim y As Variant
'Dim IE As New InternetExplorer
Sheets("Address").Select
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objie = CreateObject("InternetExplorer.Application")
For r = 4 To 8
myaddress = Cells(r, 5).Value
mycity = Cells(r, 7).Value
mystate = Cells(r, 8).Value
myzipcode = Cells(r, 9).Value
'myaddress = Range("a2").Value
'mycity = Range("c2").Value
'mystate = Range("d2").Value
'myzipcode = Range("e2").Value
With objie
.Visible = True
.navigate "https://tools.usps.com/go/ZipLookupAction!input.action"
Do While .Busy
DoEvents
Loop
Set what = .document.getElementsByName("tAddress")
what.Item(0).Value = myaddress
Set zipcode = .document.getElementsByName("tCity")
zipcode.Item(0).Value = mycity
Set zipcode1 = .document.getElementsByName("tState")
zipcode1.Item(0).Value = mystate
Set zipcode2 = .document.getElementsByName("tZip-byaddress")
zipcode2.Item(0).Value = myzipcode
.document.getElementByID("zip-by-address").Click
Do While .Busy
DoEvents
Loop
For Each ele In .document.all
Select Case ele.className
Case "industry-detail"
test = ele.innertext
testarray = Split(test, vbCrLf)
Worksheets("Address").Cells(r, 11).Value = testarray(4)
'Debug.Print test
'Debug.Print "and"
'Debug.Print testarray(4)
End Select
Next ele
End With
Next r
Set objie = Nothing
Set ele = Nothing
Set IE = Nothing
'IE.Quit
End Sub
What I think you are trying to do is input address details and retrieve the found zipcode. This method uses CSS selectors to target the page styling and I start immediately with the address search URL. I use id selectors where possible (which is the same as saying .document.getElementById("yourID"), denoted by # as these are the quickest retrieval methods. When it comes to choosing state, which is a dropdown, I select the appropriate option. You could concantenate the search state 2 letter abbreviation into the option string e.g.
Dim state As String
state = "NY"
.querySelector("option[value=" & state & "]").Selected = True
There is a loop to ensure the target element is present in new search results page. I use another CSS selector of #zipByAddressDiv strong to target just the zipcode, which is in bold, in the results. The bold is set by the strong tag.
strong tag holding zipcode in result:
CSS query:
The above CSS selector is target by id using #zipByAddressDiv and then, rather than splitting into an array to get the value you want, it uses a descendant selector to target the strong tag element holding the required value.
VBA:
Option Explicit
Public Sub AddressSearch()
Dim IE As New InternetExplorer, t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#tAddress").Value = "1 Main Street"
.querySelector("#tCity").Value = "New York"
.querySelector("option[value=NY]").Selected = True
' .querySelector("#tZip-byaddress").Value = 10045
.querySelector("#zip-by-address").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = .document.querySelector("#zipByAddressDiv strong")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
Debug.Print ele.innerText
.Quit
End With
End Sub
Here is what that looks like in a loop:
Option Explicit
Public Sub AddressSearch()
Dim IE As New InternetExplorer, t As Date, ele As Object, i As Long
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Address")
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
For i = 4 To 8
.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#tAddress").Value = ws.Cells(i, 5).Value
.querySelector("#tCity").Value = ws.Cells(i, 7).Value
.querySelector("option[value=" & ws.Cells(i, 8).Value & "]").Selected = True
' .querySelector("#tZip-byaddress").Value = 10045
.querySelector("#zip-by-address").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = .document.querySelector("#zipByAddressDiv strong")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
ws.Cells(i, 11) = ele.innerText
Set ele = Nothing
Next
.Quit
End With
End Sub
I'm trying to write a function to pass a values in Column A to the function, but can't seem to get the format correct.
Function GetClassNames(cell As Range) As Variant
Dim MyCell As String
MyCell = cell.value
objIE.navigate "www.mysite.com/archive.aspx?code=" & Range(MyCell).Text
Here is the working Subroutine
Sub GetNames()
Dim HTML As HTMLDocument
Dim objIE As Object
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.cattle.com/markets/archive.aspx?code=" & Range("A1").Text
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
y = 2
Set HTML = objIE.document
Set elements = HTML.getElementsByClassName("list-group-item")
For Each element In elements
If element.className = "list-group-item" Then
Sheets("Sheet2").Cells(1, y).Value = element.innerText
Selection.NumberFormat = "yyyy-mm-dd"
y = y + 1
End If
Next element
End Sub
I made a code that can use the cell in A2 to search it in a specific website and pull down the criteria that I need. I'm having trouble making the correct loop for this. Can someone point me in the right direction? (cells from A2 to A1829)
Code:
Sub SearchBot()
Dim objIE As InternetExplorer
Dim aEle As HTMLLinkElement
Dim y As Integer
Dim result As String
Dim TR As Object, TD As Object
Dim tbl As Object, obj_tbl As Object
Dim lastRow As Long
Dim start_time As Date
Dim end_time As Date
Set objIE = New InternetExplorer
objIE.Visible = True 'make IE browser visible
objIE.navigate "https://capitaliq.com"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
For i = 1 to 1829
objIE.document.getElementById("SearchTopBar").Value = _
Sheets("Sheet2").Range("A" & i).Value
Set oNode = objIE.document.getElementsByClassName("iPadHack tmbsearchright")(0)
oNode.Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
b = 2
Dim tblEle As Object
Set tblEle = objIE.document.getElementsByClassName("cTblListBody")(5)
Sheets("Sheet2").Range("B" & b).Value = tblEle.innerText
Debug.Print tblEle.innerText
b = b + 1
Next i
objIE.Quit
End Sub
you're not using the loop variable i anywhere, guessing it should be this line:
Sheets("Sheet2").Range("A").Value
change to:
Sheets("Sheet2").Range("A" & i).Value