I have attempted quite a few variations however this i believe is the closest i have gotten to having it working and I simply do not know how to proceed.
Here is the basic concept.
I have a url that will trigger the creation and the download of an XLS formatted file.
My code gets all the way to opening this file with the use of sendkeys(%a accepts the security warning (would like to skip if there is a way, at this point i need to basically make sure that the opened file from download is the active window before proceeding. keep in mind the downloaded filename can vary slightly.
There is still some garbage from other things i was attempting.
Question: How can I do a loop until, or if, etc to insure that the active window is either MyBrowser(IE) or the Excel workbook i just opened with the send keys?
Sub SearchRepQ()
Dim USER1 As String
'USER1 = Application.WorksheetFunction.Index(Sheets("SRC").Range("D:D"), Application.WorksheetFunction.Match(UserForm1("TextBox1"), Sheets("SRC").Range("C:C"), 0))
Dim prefix1 As String
Dim prefix2 As String
prefix1 = "https://MyReports.com/default.aspx?&sk=Mgmt+Console&s=~_d0!2!1!!1!7!0!1!!2!!!0!1!3!2!_d2!"
prefix2 = "!Central+Standard+Time!_d6!fvf%7c%40ticketowner!DrurxrErsrzqFqypvspwpxpCpvtpwpwpqBqypvspwpxpApvtpwpwpqqrzqqqrur!fvf%7c%40ticketstatusopenclosed!_d0!4!Mgmt+Console!Open!_d1!_d8!!yqHqtFpGpxpvppupxpupvpupwppwpppupvpKpJpIpEpzpBpApCppDpqyprpqsq!&xls=h$Mgmt_32_Console$ctl00$mup$t$ctl00$ctl00$exl"
Dim MyURL1 As String
Dim MyURL2 As String
MyURL1 = ("https://MyReports.com")
MyURL2 = (prefix1 & USER1 & prefix2)
Dim MyBrowser As SHDocVw.InternetExplorer
Set MyBrowser = New InternetExplorer
Dim XL As Excel.Application
'Dim IEe As New IEEvents
Set XL = Excel.Application
'Set IEe.IEApp = MyBrowser
MyBrowser.Silent = True
MyBrowser.Visible = True
MyBrowser.navigate MyURL1
Do Until MyBrowser.READYSTATE = READYSTATE_COMPLETE: DoEvents: Loop
MyBrowser.navigate MyURL2
Do Until MyBrowser.READYSTATE = READYSTATE_COMPLETE: DoEvents: Loop
VBA.AppActivate MyBrowser.document.Title & " - " & MyBrowser.Name, 0
Application.Wait (Now + TimeValue("0:00:3"))
SendKeys "%(o)"
Application.Wait (Now + TimeValue("0:00:1"))
SendKeys "%(a)"
'Dim counter As Integer
' Set counter = 0
'Dim number As Integer = 8
'Do Until number = 10
' If number <= 0 Then Exit Do
' number -= 1
' counter += 1
'Loop
VBA.AppActivate XL.ActiveWindow.Activate.Title("coveo*", 0)
end sub
Related
The goal is to get images from Google Images that match the part numbers in my database. My code runs, and it pulls up the correct Google pages but refuses to put the links into the spreadsheet. I have tried everything I can think of, but as of now, I keep on getting Error 1004 (Application-defined or Object-defined error).`
Sub SearchBotGoogleImgLink()
Dim objIE As Object
Set IE = CreateObject("InternetExplorer.Application")
Dim HTMLdoc As HTMLDocument
Dim imgElements As IHTMLElementCollection
Dim imgElement As HTMLImg
Dim aElement As HTMLAnchorElement
Dim n As Integer
Dim i As Integer
Dim url As String
Dim url2 As String
Dim m As Long
Dim lastRow As Long
Dim url3 As String
Dim SearchRow As Long
Dim aEle As HTMLLinkElement
Worksheets("Sheet1").Select
SearchRow = 1
Do Until IsEmpty(ActiveSheet.Cells(SearchRow, 1))
Sheets("Sheet1").Select
Application.StatusBar = SearchRow - 1 & " of " & "4368" & " Items Done"
Item = Trim(ActiveSheet.Cells(SearchRow, 1))
url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate url
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
For Each aEle In objIE.document.getElementsByTagName("IMG")
result = aEle
Sheets("Sheet1").Range(SearchRow & "C").Value = result
Sheets("Sheet1").Range(SearchRow & "D") = aEle.innerHTML
Sheets("Sheet1").Range(SearchRow & "F").Value = aEle.innerText
Debug.Print aEle.innerText
Next
Loop
'For i = 1 To lastRow
'url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set HTMLdoc = objIE.document
Set imgElements = HTMLdoc.getElementsByTagName("IMG")
n = 1
For Each imgElement In imgElements
If InStr(ingElement.src, sImageSearchString) Then
If imgElement.ParentNode.nodeName = "A" Then
Set aElement = imgElement.ParentNode
If n = 2 Then
url2 = aElement.href 'imgElement.src
url3 = imgElement.src 'aElement.href
n = n + 1
End If
End If
End If
Next
Cells(SearchRow, 5) = url2
IE.Quit
Set IE = Nothing
End Sub
Notes on your code:
You need Option Explicit at the top of your code to check on variable declarations and typos amongst other advantages. There are a number of missing declarations e.g. result, and used ones later e.g. Set IE = CreateObject("InternetExplorer.Application"). You have two different variables (one late bound and one early) both creating IE instances. You only in fact use one.
Your current error may be down to you trying to work with an object here:
result = aEle which won't work without the Set keyword to provide the required reference.
Without example URLs and expected output it is difficult to advise on the later loops in your code. You appear to have a duplicate loop over IMG elements but this time with some restrictions. It is likely these loops can be merged.
An example:
The following uses an arbitrary concatenation in to pull the img src links in from search results based on A2N0015C3KUU.
It uses a CSS selector combination of #ires img[src] to target elements with img tags and src attributes within the parent element with id ires (search results).
It is to demonstrate the principle of gathering aNodeList of matching elements and writing out to a sheet. The querySelectorAll method applied the CSS selector combination to the HTMLDocument and returns the nodeList. The nodeList is looped along its .Length, with items accessed by index starting at 0.
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
With IE
.Visible = True
.navigate "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=1&%20%22&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelectorAll("#ires img[src]")
For i = 0 To aNodeList.Length - 1
ActiveSheet.Cells(i + 2, 4) = aNodeList.item(i).src
Next
'Quit '<== Remember to quit application
End With
End Sub
All that I know now about VBA is mostly thanks to this site - you are the best <3
However, for last two days I've been looking for a solution and couldn't work it out by usual research.
Background:
I have a site with a table in it. Table represents prices for product X. There are many products, but table shows only active product. When I click on Y/Z/M, the URL stays same, only table itself updates. I need to build a database for many products, so I loop through the list by looking for elements and clicking on them and then try to fish rows/cells/etc.
Problem:
For same code, same list, same data I end up with non identical databases. Some entries are missing, some entries repeat prices of previous products etc.
Theory what's not working:
After thorough F8-testing, I think this is not working properly:
Do Until Not appIE.Busy And appIE.READYSTATE = 4
Application.Wait (Now + TimeValue("0:00:02"))
Loop
Application.Wait (Now + TimeValue("0:00:05"))
When I go through my macro by F8, all data is being fished properly. It looks like somehow the VBA doesn't wait for the html.document to fully update.
What I'de done so far:
I played around with various configurations (Do While, Do Until Not etc) of the usual loop.
I added the site to "trusted" sites in IE, as someone somewhere suggested it would help. Got scary errors afterwords and I had no idea what to do with them, so "untrusted" the site. No more error messages.
I tried to "reset" the HTML.Document.
I figured out where in the page the actual info about status bar on screen shows up and asked VBA to make sure that name changes from "Modal In" to "Modal":
Set checkA = html.getElementById("processingModal")
Dim trytry As String
Do While trytry = "modal in"
trytry = checkA.className
Application.Wait (Now + TimeValue("0:00:01"))
Loop
I still end up with messed up output.
Below, I'm adding my full code. I would also appreciate greatly any advice, as this is my first web scraping code ever and I'm self taught.
Many thanks in advance, Good People!
Sub try_this()
'trying scraping from web
Dim appIE As Object
Dim html As HTMLDocument
Dim lngRow, i, lngColumn, lngYear, a, s As Long
Dim tblSummary As IHTMLTable
Dim tblRows As IHTMLElementCollection
Dim tblRow As IHTMLElement
Dim tblCells As IHTMLElementCollection
Dim tblCell As IHTMLElement
Dim tblDataValue As String
Dim VintagesList As IHTMLElement
Dim Vintages As IHTMLElementCollection
Dim Vintage As IHTMLElement
Dim VintageYear As String
Dim BtlSizesList As IHTMLElement
Dim BtlSizes As IHTMLElementCollection
Dim BtlSize As IHTMLElement
Dim BtlSizeValue As String
Dim btlSizeID As String
Dim objA As IHTMLElement, checkA As IHTMLElement
Dim strAddress As String, strVintageY As String
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Application.ScreenUpdating = False
'part 1: open IE browser and go to page with products
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "My web Page"
.Visible = True
End With
Do While appIE.Busy 'so far works all right
DoEvents
Loop
Set html = appIE.Document
For lngYear = 2 To 16 'product category list
Application.StatusBar = "Downloading data for year " & lngYear - 1 & " of 15..."
strVintageY = Sheets("Dict").Range("A" & lngYear).Value 'first cathegory
strAddress = Sheets("Dict").Range("D2").Value & strVintageY & Sheets("Dict").Range("D4").Value & strVintageY 'changes physical address in a browser
appIE.Navigate strAddress
appIE.Visible = True
Do While appIE.Busy
Application.Wait (Now + TimeValue("0:00:02")) ' aaand wait some more, because the trick doesn't work and I'm desperate
Loop
Application.Wait (Now + TimeValue("0:00:05"))
Set html = AppIE.Document 'this is the EDIT part
'STEP 2: get available product names
Set BtlSizesList = html.getElementById("auction-size-tabs")
Set BtlSizes = BtlSizesList.Children
i = 2 'i=2, we'll start to print data into row 2
Sheets("Dict").Range("B2:B100").Clear
For Each BtlSize In BtlSizes
BtlSizeValue = BtlSize.innerText
Sheets("Dict").Cells(i, 2).Value = BtlSizeValue
i = i + 1
Next
'Step 2b: Fish Prices Data Table
lngRow = Sheets("Database").Range("D" & Rows.Count).End(xlUp).Row
s = Sheets("Dict").Range("B" & Rows.Count).End(xlUp).Row 's = last row with product's name
For a = 2 To s
btlSizeID = Sheets("Dict").Range("B" & a).Value
Set objA = html.getElementById(btlSizeID).getElementsByTagName("a")(0) 'click right product on the web page
objA.Click
'Readystate and waiting:
Do Until Not appIE.Busy And appIE.READYSTATE = 4 'wait for page to load
Application.Wait (Now + TimeValue("0:00:02"))
Loop
Application.Wait (Now + TimeValue("0:00:05"))
'this is part where I physically check if the load bar is still there:
Set checkA = html.getElementById("processingModal")
Dim trytry As String
Do While trytry = "modal in"
trytry = checkA.className
Application.Wait (Now + TimeValue("0:00:01"))
Loop
'I even tried to "reset" html.document. To be honest no idea what I'm doing here.
Set html = Nothing
Set html = appIE.Document
Set tblSummary = html.getElementById("summaryTable") 'find the table
Set tblRows = tblSummary.Rows 'get list of rows in the table
For Each tblRow In tblRows
Set tblCells = tblRow.Cells
If lngRow >= 2 Then
Sheets("Database").Range("B" & lngRow).Value = btlSizeID 'condition will be removed once I figure how to skip 1st row of table in HTML
End If
lngColumn = 3
For Each tblCell In tblCells
tblDataValue = tblCell.innerText
lngColumn = lngColumn + 1
Next
If lngRow >= 2 Then
Sheets("Database").Cells(lngRow, 1).Value = strVintageY 'paste product's category into column A
End If
lngRow = lngRow + 1 'i will be row# that will have new info pasted in it
Next
Next a
Application.ScreenUpdating = True
Next lngYear
Set html = Nothing
Set appIE = Nothing
SecondsElapsed = Round(Timer - StartTime, 2)
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
Update: As suggested, I added missing line that re-sets HTML.Documnet after .Navigate event. This didn't fix my problem though.
I'm trying to write a script to pull doctor reviews from vitals.com and put them into an excel sheet.
It worked well when I just pulled the review, but when I added for it to pull the date as well, it will print the first review and date, then loads for a while, and then crashes. I'm new to all of this so I'm hoping there are some glaring mistakes I am not seeing. I just can't seem to find a way to fix it. Any help would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DocCounter As Integer
DocCounter = 2
Dim Go As String
Go = "Go"
If IsEmpty(Cells(1, 4)) And Cells(1, 3).Value = Go Then
If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo EmptySheet
Do
Dim Reviews As String
Reviews = "/reviews"
Dim IE As MSXML2.XMLHTTP60
Set IE = New MSXML2.XMLHTTP60
Application.Wait (Now + TimeValue("0:00:01"))
IE.Open "get", "http://vitals.com/doctors/" & Cells(DocCounter, 1).Value & Reviews, True
IE.send
While IE.readyState <> 4
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:01"))
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLBody As MSHTML.HTMLBody
Set HTMLDoc = New MSHTML.HTMLDocument
Set HTMLBody = HTMLDoc.body
HTMLBody.innerHTML = IE.responseText
Dim ReviewCounterString As String
Dim ReviewCounter As Integer
ReviewCounterString = HTMLDoc.getElementsByName("overall_total_reviews")(0).getElementsByTagName("h3")(0).innerText
ReviewCounter = CInt(ReviewCounterString)
'Pull info from website loop'
Dim RC As Integer
RC = 2
Dim sDD As String
Dim WebCounter As Integer
WebCounter = 0
Do
sDD = HTMLDoc.getElementsByClassName("date c_date dtreviewed")(WebCounter).innerText & "-" & HTMLDoc.getElementsByClassName("description")(WebCounter).innerText
Cells(DocCounter, RC).Value = sDD
WebCounter = WebCounter + 1
RC = RC + 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop Until WebCounter = ReviewCounter
Application.Wait (Now + TimeValue("0:00:01"))
DocCounter = DocCounter + 1
If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo Finished
Loop
Finished:
MsgBox ("Complete")
End Sub
EmptySheet:
MsgBox ("The Excel Sheet is Empty. Please add Doctors.")
End Sub
End If
End Sub
When you do Cells(DocCounter, RC).Value = sDD the Worksheet.Change event gets triggered again and the macro starts over again, until the call stack is full (I think).
Add
Application.EnableEvents = False
at the start of the macro and
Application.EnableEvents = True
at the end. That way the event will not be triggered during the macro.
Edit: You should probably also think about if it's really necessary to run the macro every time anything is changed anywhere on the sheet. You could check Target (the range that was changed) first to see if the change makes it necessary to reload the data.
What I have to do is use Excel VBA to:
login to Amazon Seller
open a workbook
loop through a column to get an order number
put it in the search box
hit the search button
go to the order page and extract the data
then have the extracted data go back into a specified column in
another Excel workbook
The loop and order number parts are what I'm currently stumped on. I've figured out this much code as of this moment:
Sub MyAmazonSeller()
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
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
' See if you have the sign in link is because you are in the main
' page
Set oSignInLink = HTMLDoc.getElementById("signin-button-container")
If Not oSignInLink Is Nothing Then
oSignInLink.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
End If
' Get the email field and the next button
Set oInputEmail = HTMLDoc.getElementById("username")
Set oInputPassword = HTMLDoc.getElementById("password")
' Click the button and wait
oInputEmail.Value = "xxxxxx#xxxxxx.net"
' Get the password field and the sign in button
Set oInputPassword = HTMLDoc.getElementById("password")
Set oInputSigninButton = HTMLDoc.getElementById("sign-in-button")
' Click the button and wait
oInputPassword.Value = "xxxxxxxx"
oInputSigninButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:05"))
Set AAOrder = Application.Workbooks.Open("Z:\Employee Folders\Employee\trackingnumber_sample_spreadsheet.xls")
Set AAws = AAws.Worksheets("PrimeOrdersWithNoFulfillmentRe")
Set InputSearchOrder = HTMLDoc.getElementById("sc-search-field")
'What I'm currently stuck on
InputSearchOrder.Value = "001-7163923-7572632"
Set InputSearchButton = HTMLDoc.getElementsByClassName("sc-search-button")(0)
InputSearchButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
'Was able to add this snippet, but I'm getting an error 13, most likely with
'my e variable. I'm basically trying to do a loop within a loop, extracting 5
'pieces of data and sticking them back into their respective columns in the
'original Excel sheet. The problem comes when scraping the HTML. I'm basically
'trying to get text in the tables which have a few levels and it's frustrating
'me to no end.
With HTMLDoc
Set elems = HTMLDoc.getElementsByTagName("td")
For Each e In elems
If e.innerText Like "*1Z*" Then
Range("D2").Value = e.innerText
End If
Next e
End With
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
I code some vba scritp that open ie.navigate and get some values from webpage into excell values.
But sometimes that url does not load propetly on webpage and the values are not filled. So when the getelement try get any valume my loop camer fatal error and stoped.
another point is, imagine the all page is loadade..but for this criteria some geElementID is empyt...what I can do to avoid it.
my code here:
Sub Extract_One_Airport()
Dim IE As New InternetExplorer
Dim dtStart As Date
Datec = 0
CountRange = 1
For lSCtr = 0 To 5
Set P1 = Sheets("Inicio").Range("A9") 'Primeira p do link
Set P2 = Sheets("Inicio").Range("A10") 'Origem
link = P1 & P2
IE.navigate link
IE.Visible = True
Application.Wait (Now() + TimeValue("00:00:45")) ' For internal page refresh or loading
Dim doc As HTMLDocument
Set doc = IE.document
Dim dd As Variant
dd = doc.getElementsByClassName("valuefortoday")(0).innerText
Sheets("Resul").Range("C" & CountRange).Value = dd
Count = Count + 1
CountRange = CountRange + 1
Next
End Sub
As I said..sometimes the getElementsByClassName("valuefortoday")(0).innerText cames empty, cause the site there no information for this day...how can I avoid empty values and skip it for the next day?
This write the clipboard to StdOut. As you can only use IE's clipboard in the intranet zone without security dialogs, I navigate to a local file and wait for it to finish loading.
You can also do it with events.
Sub Clip
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = 0
ie.Navigate2 FilterPath & "Filter.html"
Do
wscript.sleep 100
Loop until ie.document.readystate = "complete"
txt=ie.document.parentwindow.clipboardData.GetData("TEXT")
ie.quit
If IsNull(txt) = true then
outp.writeline "No text on clipboard"
else
outp.writeline txt
End If
End Sub
You can check the lenght property of valueForToday. If there is no such element then lenght will be equal to zero.
IE.navigate link
' wait until the page is fully loaded
Do Until IE.readyState = 4: DoEvents: Loop
IE.Visible = True
Dim valueForToday
Set valueForToday = doc.getElementsByClassName("valuefortoday")
If valueForToday.Length > 0 Then
' element exists, get its inner text
dd = valueForToday(0).innerText
Sheets("Resul").Range("C" & CountRange).Value = dd
Count = Count + 1
CountRange = CountRange + 1
End If