I'm working on the Selenium Basic Wrapper for Excel VBA, but upon clicking a button that opens a new tab, I am unable to get the selenium web-driver to switch focus onto the new tab that is opened, and to close the original tab.. Believe this should be achievable using the Java Selenium, but is there any way to do it through the Selenium Basic wrapper on excel VBA?
Have tried using bot.switchtopreviouswindow/nextwindow to no avail, Selenium does not even seem to detect the new tab/window opened as an existing window, also tried using switchwindow using title to no avail...
Private Sub CommandButton1_Click()
Dim bot As New ChromeDriver
Dim merchant As String
Dim promocode As Object
Dim number As Long
Dim test As Object
Dim testnumber As Integer
lastColumn = Sheets("Merchants").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastColumn
bot.Get (Sheets("Merchants").Range("B" & i).Value)
merchant = Sheets("Merchants").Range("A" & i).Value
For Each promocode In bot.FindElementByClass("main_vouchers").FindElementsByClass("c")
number = Right(promocode.Attribute("id"), 6)
If IsEmpty(promocode) = True Then Exit For
promocode.FindElementByClass("go").Click
#This is the part I have problems with as after click, original page re-directs to another page, and new tab opens (which is the place I want focus on). Also, I need the original tab closed so that Chrome doesn't end up opening too many tabs due to the loop running. Appreciate the help!
Next promocode
Next i
End Sub
Just need Selenium to switch focus onto newly opened tab and for old/original tab to be closed..
The following works for me where you use switchToNextWindow and then you take 1 off the current window count (you might want to check more .windows.count > 1 first), and close that item in windows collection.
You can also .SwitchToWindowByName and .SwitchToWindowByTitle if either of those are known in advance | can be extracted from the current page.
'Ensure latest applicable driver e.g. ChromeDriver.exe in Selenium folder
'VBE > Tools > References > Add reference to selenium type library
Public Sub Example()
Dim d As WebDriver
Set d = New ChromeDriver
Const URL = "https://www.cuponation.com.sg/agoda-discount-code"
With d
.get URL
Debug.Print .Window.Title
.FindElementByCss(".go").Click
.SwitchToNextWindow
Debug.Print .URL '<= includes voucher code
'do something with new window
Debug.Print .Window.Title
.Windows.item(.Windows.Count - 1).Close 'close prior window
Debug.Print .Window.Title
Stop
.Quit
End With
End Sub
Sub DownloadFileFromLaquintaca2()
Dim cd As New selenium.ChromeDriver
Dim DefaultChromeDownloadFolder As String
Dim MyURL As String
' Start Chrome
Set cd = New ChromeDriver
cd.Start
' Navigate to
cd.get "https://www.laquintaca.gov/connect/short-term-vacation-rentals"
Const URL = "https://www.cuponation.com.sg/agoda-discount-code"
Dim FindBy As New selenium.By
Dim imgElement As selenium.WebElement
' Check if element is present with CSS
If Not cd.IsElementPresent(FindBy.Css("img[alt='ACTIVE & SUSPENDED PERMITS BOX']")) Then
MsgBox "Could not find image box"
Exit Sub
End If
cd.FindElementByCss("img[alt='ACTIVE & SUSPENDED PERMITS BOX']").Click
Application.Wait (Now + TimeValue("0:00:3"))
'Get URL Address in Second Chorme Tab
With cd
.get URL
.SwitchToNextWindow
MyURL = .URL
'Debug.Print .Window.Title
'Debug.Print myURL
.Windows.Item(.Windows.Count - 1).Close 'close prior window
End With
'Write PDF File into Location with file Name STVR.PDF ---D:\MyDownLoads\STVR.pdf
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", MyURL, False, "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "D:\MyDownLoads\STVR.pdf", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
Related
I have 40 links imported in an excel sheet. Each link, when clicked, will lead to (Print as file) window for the page.
Is there anyway to open the multiple links and save the page as PDF with specific format (Year_Month_date) with one click ?
Create PDF-File with Timestamp
this should work for you! you can delete "hhmmss" for only Year_Month_Day !
Sub PDFCreate()
Sheets("Tabelle1").PageSetup.Orientation = 1 ' 1=portrait, 2=landscape
With Sheets("Tabelle1")
.PageSetup.PrintArea = "$A$1:$I$21"
.ExportAsFixedFormat xlTypePDF, "C:\Users\username\Documents\foldername\" & Format(Now, "yyyymmdd hhmmss") & "pdfname.pdf", , , False
End With
End Sub
Print and Open Webpage from VBA Code
Sub print_PDF()
Dim Explorer As Object
Dim eQuery As Long ' return value
Dim i As Integer
Dim fTime As Single
Set Explorer = CreateObject("InternetExplorer.Application") ' Connect to Explorer
Dim url As String
url = ThisWorkbook.ActiveSheet.Range("A1").Value
Explorer.Navigate url ' Open document from local or web!
TryAgain:
'Wait 2 seconds to let IE load
fTime = Timer
Do While fTime > Timer - 2
DoEvents
Loop
eQuery = Explorer.QueryStatusWB(6) ' print command
If eQuery And 2 Then
Explorer.ExecWB 6, 2, "", "" ' Print (6), displaying dialog (2)
'Wait for 2 seconds while IE prints
fTime = Timer
Do While fTime > Timer - 2
DoEvents
Loop
Else
GoTo TryAgain
End If
End Sub
UPDATE: Added Insert Option
u are able to insert link into input dialog, it automatically changes link in Sub pdf_Print()
Sub Insert()
Dim myValue As Variant
myValue = InputBox("Need Input")
Range("A1").Value = myValue
End Sub
https://www.laquintaca.gov/connect/short-term-vacation-rentals
The site above has a cluster of images. On of those images is a box with the text value "ACTIVE AND SUSPENDED PERMITS". Click on the image takes you to a PDF that is downloadable. I would like to automate that download process to my desktop. The "orange" image stays the same but the href address changes every two weeks(document serial number on the end) when they upload a new PDF.
More directly, How do i click on the orage image space to get to the underlying, but bi-weekly changing PDF?
I can not find the actionable object address to click to take me to the downloadable document. What is the VBA Selenium code line to "click"
'*****************************************************************************
Sub FindingElements()
Set cd = New Selenium.ChromeDriver
cd.Start
cd.Get "https://www.laquintaca.gov/connect/short-term-vacation-rentals"
'"https://www.laquintaca.gov/connect/short-term-vacation-rentals"
'=================================================================
'Find Element By ID or Name
'=================================================================
Dim SearchInput As Selenium.WebElement
Dim SearchButton As Selenium.WebElement
Dim FindBy As New Selenium.By
'
If Not cd.IsElementPresent(FindBy.ID("OuterContainer")) Then
MsgBox "Could not find search input box"
Exit Sub
End If
'
' Set SearchInput = cd.FindElementById("OuterContainer")
' Set SearchInput = cd.FindElement(FindBy.ID("searchInput"))
' Set SearchInput = cd.FindElementByName("search")
' Set SearchInput = cd.FindElementByCss("#searchInput")
' Set SearchInput = cd.FindElementByCss("[name='search']")
' Set SearchInput = cd.FindElementByXPath("//*[#id='searchInput']")
You can do it with CSS or XPath. I prefer CSS because XPath is more complex and sometimes slower than CSS.
The first procedure waits until the file is downloaded.
I used a procedure by Paul_Hossler to find the ChromeDownloadFolder.
Sub DownloadFileFromLaquintaca()
Dim cd As New Selenium.ChromeDriver
Dim DefaultChromeDownloadFolder As String
' Get Chrome download folder
DefaultChromeDownloadFolder = ChromeDownloadFolder
' Start Chrome
cd.Start
' Navigate to
cd.Get "https://www.laquintaca.gov/connect/short-term-vacation-rentals"
Dim FindBy As New Selenium.By
Dim imgElement As Selenium.WebElement
' Check if element is present with CSS
If Not cd.IsElementPresent(FindBy.Css("img[alt='ACTIVE & SUSPENDED PERMITS BOX']")) Then
MsgBox "Could not find image box"
Exit Sub
End If
' Click to download
cd.FindElementByCss("img[alt='ACTIVE & SUSPENDED PERMITS BOX']").Click
' Wait until download is completed
Do While Dir(DefaultChromeDownloadFolder & "\" & "STVRCurrentActiveSuspended.pdf") = ""
DoEvents
Loop
End Sub
Function ChromeDownloadFolder()
' By Paul_Hossler
Dim sPref As String
Dim iFile As Long, iStart As Long, iEnd As Long
Dim sBuffer As String, sSearch As String, sDownloads As String
' Chrome preferces file, no extension
sPref = Environ("LOCALAPPDATA") & "\Google\Chrome\User Data\Default\Preferences"
' marker
sSearch = """download"":{""default_directory"":"
' read the whole file into buffer
iFile = FreeFile
Open sPref For Input As #iFile
sBuffer = Input$(LOF(iFile), iFile)
Close #iFile
' find start of marker
iStart = InStr(1, sBuffer, sSearch, vbTextCompare)
' find comma
iEnd = InStr(iStart + Len(sSearch), sBuffer, ",", vbTextCompare)
' pull out path
sDownloads = Mid(sBuffer, iStart + Len(sSearch) + 1, iEnd - iStart - Len(sSearch) - 2)
' remove double back slashes
ChromeDownloadFolder = Replace(sDownloads, "\\", "\")
End Function
I solved the issue I was having with the SUB below that works perfectly. Thank you so much for you fantastic help. The code blow swithces to the Current code tab, reds the URL then downloads to a location via the WinHttpReq = CreateObject("Microsoft.XMLHTTP") process:
Sub DownloadFileFromLaquintaca2()
Dim cd As New selenium.ChromeDriver
Dim DefaultChromeDownloadFolder As String
Dim MyURL As String
' Start Chrome
Set cd = New ChromeDriver
cd.Start
' Navigate to
cd.get "https://www.laquintaca.gov/connect/short-term-vacation-rentals"
Const URL = "https://www.laquintaca.gov/connect/short-term-vacation-rentals"
Dim FindBy As New selenium.By
Dim imgElement As selenium.WebElement
' Check if element is present with CSS
If Not cd.IsElementPresent(FindBy.Css("img[alt='ACTIVE & SUSPENDED PERMITS BOX']")) Then
MsgBox "Could not find image box"
Exit Sub
End If
cd.FindElementByCss("img[alt='ACTIVE & SUSPENDED PERMITS BOX']").Click
Application.Wait (Now + TimeValue("0:00:3"))
'Get URL Address in Second Chorme Tab
With cd
'.get URL
.SwitchToNextWindow
MyURL = .URL
'Debug.Print .Window.Title
'Debug.Print myURL
.Windows.Item(.Windows.Count - 1).Close 'close prior window
End With
'Write PDF File into Location with file Name STVR.PDF ---D:\MyDownLoads\STVR.pdf
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", MyURL, False, "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "D:\MyDownLoads\STVR.pdf", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
this might seem a question asked many times, however I was not able to find one that fits with my requirement.
The macros I'd need to create will be used for many users and everybody must use their standard company credentials. I cannot create any userform asking for that or hard code anything as it would breach the company security rules.
Nowadays, I'm using Webbrowser control in combination with DownloadURLtoFile function or winHTTReq to download files. Users launch a userform with a Webbrowser, enter their credentials, then I test if the login was successful and hide the userform. Then while I surf to the right URL file, I scrape some other useful information and finally download the report smoothly. Both file download methods use the loged-in webcontrol session already in place and don't need anything else.
Unfortunately, the behavior with IE object is not the same, when I run any of both methods after the user login successfully and I hide the screen, the file downloaded has the http code asking for a user id and password.
Does anybody know if it's possible to bind any of these two file download method to use an IE object session?
Sorry for the long explanation, hope I've been clear with my request.
P.S.: If you ask why I'm moving to IE if Webbrowser control works is because, I need to scrape different pages with java script containers and it's way more easier with IE.
Hello #Deepak-MSFT to to your question, the answer is No, the file I've got when the session is not logged comes from the right page.
Here you go the macros which works correctly:
Sub Login()
URL = "myapplication.com"
UserForm1.WebBrowser1.navigate URL '<- This request is redirected to the global login page.
'Wait until page is fully loaded
Do While UserForm1.WebBrowser1.ReadyState = 4: DoEvents: Loop
Do Until UserForm1.WebBrowser1.ReadyState = 4: DoEvents: Loop
While UserForm1.WebBrowser1.Busy
DoEvents
Wend
UserForm1.show
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'This Macro is located in the UserForm1. Will leave Webbrowser opened until the user
'loggin succesffuly. After that I hide the userform and continue with the download.
'Check if appls is logged and hide the browser
LoginStatement = "Welcome to the Intranet" '<= String which appears when appls is logged
Document = WebBrowser1.Document.DocumentElement.innerText
pos1 = InStr(Document, LoginStatement)
If pos1 Then
Me.hide
End If
End Sub
Sub Download()
'Main procedure
Dim myURL As String: myURL = "myapplication.com"
Call Login
sFile_Name = "test.csv"
sPath = "c:\temp"
sFile_Path = sPath & "\" & sFile_Name
Dim winHttpReq As Object
Set winHttpReq = CreateObject("Microsoft.XMLHTTP")
winHttpReq.Open "GET", myURL, False
winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
On Error GoTo URL_Unreachable
winHttpReq.Send
On Error GoTo Wrong_Directory
If winHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write winHttpReq.ResponseBody
oStream.SaveToFile sFile_Path, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
Else
MsgBox "Something went wrong... file couldn't be downloaded"
End If
Set winHttpReq = Nothing
Exit Sub
URL_Unreachable:
MsgBox "URL unreachable. Please check your connection and try again"
Application.StatusBar = False
Set winHttpReq = Nothing
End
Wrong_Directory:
Application.StatusBar = "Reporting path directory inaccessible"
MsgBox "The Reporting path: " & sPath & " is not accesible or you don't have enough permisions." & _
vbCrLf & vbCrLf & "Please update it and try again"
Application.StatusBar = False
Set winHttpReq = Nothing
End
End Sub
Then, if I replace the previous login macro by the following, the file is not downloaded as Excel does not see any open session established.
Sub login()
Dim HTMLDoc As MSHTML.HTMLDocument
Dim URL, LoginStatement As String: URL = "myapplication.com"
Dim pos1 As Integer: pos1 = 0
LoginStatement = "Welcome to the Intranet" '<= String which appears when appls is logged
Set IE = New InternetExplorerMedium
With IE
.Navigate URL: .visible = True
Do While .ReadyState <> READYSTATE_COMPLETE Or .Busy
Loop
On Error Resume Next
Set HTMLDoc = .Document.DocumentElement.innerText
If (pos1 = InStr(Document, LoginStatement)) Then
.visible = False
Exit Sub
End If
Wend
End Sub
I am able to download and open file and i need to copy data from downloaded file and paste to other file. The problem is that sometimes is working sometimes is not working, I didnt get the point where is the mistake. I also need to wait until downloading completed. To wait until downloading progress, I put a popup message (MsgBox "Download Successful, Click OK") Because I havent found a solution. If there is a option, I would like to remove the popup. Download File name start with SEARCH thats why I am looking for a key word but sometimes, application doesnt see as active workbook.Download progress and open file is successful but sometimes active sheet is not recognizing by excel. One of the option I can save and open it, if it possible i can do it or open the file and wait until download progress and copy data from SEARCH...xlsx file. HOW can wait until download progress and application can see the workbook?
I have tried to merge this code to my code but I havent done it. VBA code to wait until file download from IE is complete
Dim HTMLDoc As HTMLDocument
Dim login As InternetExplorer
Sub Login_Website()
Dim oHTML_Element As IHTMLElement
Dim login_URL As String
On Error GoTo Err_Clear
' This is login URL to website
login_URL = "Website URL"
Set login = New InternetExplorer ' The object for the login
' Timeout set for the web browser
login.Silent = True
login.timeout = 60
' This parts making Visible or not_Visible
login.Visible = True
Do
' Wait till the Browser is loaded
Loop Until login.readyState = READYSTATE_COMPLETE
Set HTMLDoc = login.document
HTMLDoc.all.os_username.Value = "username"
HTMLDoc.all.os_password.Value = "password"
HTMLDoc.all.Item("login").Click
' To submit Login
For Each oHTML_Element In HTMLDoc.getElementsByTagName("login")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
Do Until login.readyState = READYSTATE_COMPLETE: DoEvents: Loop
'THE PROBLEM IS STARTING FROM THIS POINT
Dim o As IUIAutomation
Dim e As IUIAutomationElement, download_check As IUIAutomationElement
Set o = New CUIAutomation
Dim h As Long
h = login.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Open")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
MsgBox "Download Successful, Click OK"
' This part searching active workbook
Dim xWBName As String
Dim GetBook As String
Dim xWb As Workbook
For Each xWb In Application.Workbooks
'xWBName = xWb.Name 'xWBName & xWb.Name & vbCrLf
If InStr(xWb.Name, "Search") Then
GetBook = xWb.Name
End If
Next
'Activate the required workbook
Workbooks(GetBook).Activate
I have the following code from http://dailydoseofexcel.com/archives/2011/03/08/get-data-from-website-that-requires-a-login/#comment-60553
Sub GetTable()
Dim xml As Object ' MSXML2.XMLHTTP60
Dim htmlDoc As Object ' MSHTML.HTMLDocument
Dim htmlBody As Object ' MSHTML.HTMLBody
Dim ieTable As Object
Dim clip As DataObject
Set xml = GetMSXML
With xml
.Open "POST", "https://web.site", False
.send "username=myname&password=mypassword"""
End With
With xml
.Open "POST", "https://web.site/anotherpage", False
End With
Set htmlDoc = CreateHTMLDoc
Set htmlBody = htmlDoc.Body
htmlBody.innerHTML = xml.responseText
Set ieTable = htmlBody.all.Item("report")
'copy the tables html to the clipboard and paste to teh sheet
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "<html>" & ieTable.outerHTML & "</html>"
clip.PutInClipboard
Range("A1").Select
ActiveSheet.PasteSpecial "Unicode Text"""
End If
End Sub
Function CreateHTMLDoc() As Object ' MSHTML.HTMLDocument
Set CreateHTMLDoc = CreateObject("htmlfile")
End Function
Function GetMSXML() As Object ' MSXML2.XMLHTTP
On Error Resume Next
Set GetMSXML = CreateObject("MSXML2.XMLHTTP")
End Function
Using this code I am attempting to access the site web.site and pass it a username and password to login, before proceeding to another page on the site, before copying the content of a table (results) into sheet1 of the excel workbook.
I have tried to debug this using f8 but without the visual browser that I would get if I were to follow this page http://dailydoseofexcel.com/archives/2011/03/08/get-data-from-website-that-requires-a-login/
then its a bit difficult to see exactly what is happening and where it is failing.
Try the following code to assist you go onto the site, if you have any questions then just leave a comment on my channel https://www.youtube.com/watch?v=hfAhmae4iqA ;
Dim IEe As InternetExplorer
Dim doc, element
Set IEe = New InternetExplorer
IEe.Visible = False 'make true if you want to the internet explorer
IEe.Navigate "YOUR WEBSITE"
Do While IEe.ReadyState = 4: DoEvents: Loop
Do Until IEe.ReadyState = 4: DoEvents: Loop
Set element = IEe.Document.getElementByID(INSERT ELEMENT ID) 'RIGHT CLICK ON WEBSITE AND SAY INSPECT ELEMENT CLICK THE MOUSE ICON AND THEN CLICK THE TEXT BOX WHERE THE PASSWORD OR USERNAME SHOULD BE INSERTED
element.Value = "USERNAME"
Set element = IEe.Document.getElementByID(INSERT ELEMENT ID) 'THE FIRST IS FOR USERNAME THE NEXT FOR PASSWORD
element.Value = "PASSWORD" 'remember storing a password in a macro is not safe