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
Related
I have a macro which navigates to a series of web pages, downloads an excel from those pages, and then merges the data onto the open workbook. However, my code fails because it cannot find the newly downloaded workbook. When i step through the code, there is no problem. Presumably my code continues to run but as the newly downloaded workbook is not open yet, it fails.
I have tried to create a loop which waits until the downloaded workbook opens, but it seems that the workbook cannot open while the loop is running.
How can I 'wait' within my code until the workbook is open and my code can proceed?
any inputs appreciated, thank you!
appIE.document.getElementById("_id3805:_id3806:0:_id4177").Click 'click website download button
Dim o As IUIAutomation
Dim e As IUIAutomationElement, download_check As IUIAutomationElement
Set o = New CUIAutomation
Dim h As LongLong
h = appIE.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
Debug.Print "Download Successful, Click OK"
Application.Wait (Now + TimeValue("00:00:02"))
DoEvents
' This part searching active workbook
Dim xWBName As String
Dim GetBook As String
Dim xWb As Workbook
Do Until Application.Workbooks.Count > 1
' 'I am waiting for something to happen
DoEvents
Application.Wait (Now + TimeValue("00:00:01"))
Sleep 1000
Loop
For Each xWb In Application.Workbooks
'xWBName = xWb.Name 'xWBName & xWb.Name & vbCrLf
DoEvents
If InStr(xWb.Name, "Data") Then
GetBook = xWb.Name
End If
Next
DoEvents
'Activate the required workbook
**Set wb2 = Workbooks(GetBook)**
I think your approach with sleep and doEvents is a good way to solve it. Bevore opening the downloaded workbook, check in your sleep loop if it exists, then exit the loop.
If Dir(pathToFile) <> "" Then
'File has been found
end if
EDIT:
I dont see the part where you are trying to open the file.
The order in which things should happen in your case is:
1. Download file
2. Waiting-loop in which you check if the file has been downloaded
3. Open file
the sleep loop could look something like this:
'Download the file here
dim fileFound as boolean
while not fileFound
sleep(1000)
DoEvents
If Dir(pathToFile) <> "" Then
fileFound = true
end if
wend
'Open the file here
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
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
I am trying to open excel files downloded from internet and then copy the data into another excel file during vba runs with their commands.
But the command that open the excel file is executed after the ends of vba code regardless of their position.
For example, below code shows whole process of downloading and opening the excel file from a site. But at the "open_excel" function "InvokePattern.Invoke" actually occurs after the execution of all vba codes.
How do I execute this at first? Could I give some priority on that command?
Or how to wait on "InvokePattern.Invoke" until that finished?
(I try wait time or kinds of time manipulation which doesn't work)
Sub crawler_main() ' this is main function
.....
Call ieopen(ie, url_futures) 'internet explorer is opened with some url
Call click_excel(ie)
Call open_excel(ie)
Call copy_data(wbname)
.....
End Sub
Sub ieopen(ie As InternetExplorer, url As String) ' open ie
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate url
Do Until (ie.readyState = 4 And Not ie.Busy)
DoEvents
Loop
Application.Wait (Now + TimeValue("00:00:05"))
End Sub
Sub click_excel(ie As InternetExplorer) 'download excel
Dim inquiry As Object
Set inquiry = ie.document.getElementsByClassName("btn-board btn-board-search")(0)
inquiry.Click
Do Until (ie.readyState = 4 And Not ie.Busy)
DoEvents
Loop
'Application.Wait (Now + TimeValue("00:00:05"))
Dim Buttons_Excel As Object
Dim Button As Object
Set Buttons_Excel = ie.document.getElementsByTagName("button")
For Each Button In Buttons_Excel
If Button.innerHTML = "Excel" Then
Button.FireEvent ("onclick")
Exit For
End If
Next
End Sub
Sub open_excel(ie As InternetExplorer) 'click open in dialog open/save
Dim e As IUIAutomationElement
Dim o As CUIAutomation
Set o = New CUIAutomation
Dim h As Long
h = ie.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, "열기")
Dim Button_Download As IUIAutomationElement
Set Button_Download = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button_Download.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
Sub copy_data(wbname As String) 'copy data from recently opened file.
'But here is problematic since file is open after the execution of all vba codes
For Each wb In Application.Workbooks
If wb.Name Like "dat" & "*" Then
Set wb_data = Workbooks(wb.Name)
Exit For
End If
Next wb
............
End Sub
This might be relevant: http://msdn.microsoft.com/en-us/libr...87(VS.85).aspx
Note that you can use realtime which is higher but you will have to set permissions to do so...
Code:
Sub SetPriority()
Const ABOVE_NORMAL = 32768
Const HIGH = 128
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'excel.exe'")
For Each objProcess In colProcesses
objProcess.SetPriority (HIGH)
Next
End Sub
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