I have many urls in a Excel File. I am trying to Open Each URL and Print/Save the Page as PDF in silent mode. I have the below code. This works but asking for Print confirmation (Print Dialogue Window). Can anyone has idea to print in silent mode i.e. without showing print dialogue window.
Sub View_Tech_Recalls()
Set ie = CreateObject("InternetExplorer.Application")
Recall_URL = Range("A1").Value
ie.Navigate Recall_URL
ie.StatusBar = False
ie.Toolbar = True
ie.Visible = True
ie.Resizable = True
ie.AddressBar = False
TimeOutWebQuery = 5
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until ie.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
ie.stop
GoTo ErrorTimeOut
End If
Loop
Application.Wait (Now + TimeValue("0:00:03"))
ie.ExecWB 6, 2
ErrorTimeOut:
Set ie = Nothing
End Sub
I'm not sure on implementation for your requirements, but maybe ExportAsFixedFormat Type:=xlTypePDF might be your solution?
Then you can set application.displayalerts = false prior execution, so should go rather silently.
Related
It's my first question and I'm new on VBA.
I was trying to run a macro to automatize some procedures on IE. My macro worked very well when opened on diferent windows, but when I tried to run the same macro on tabs it didn't work. It seems (maybe) the macro isn't recognizing the actual tab. Could anyone help me, please?
Sub Test1()
Dim IE As Object
Dim doc As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
For intRow = 1 To 3
If intRow = 1 Then
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI/jsp/patentes/PatenteSearchBasico.jsp"
Do While IE.Busy Or IE.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
IE.document.getElementById("principal").Children(4). _
getElementsByTagName("tbody")(0).getElementsByTagName("tr")(5). _
getElementsByTagName("td")(1).getElementsByTagName("font")(0). _
getElementsByTagName("input")(0).Value = "intRow"
Application.Wait DateAdd("s", 2, Now)
End With
Else
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI/jsp/patentes/PatenteSearchBasico.jsp", 2048&
Do While IE.Busy Or IE.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
.document.getElementById("principal").Children(4). _
getElementsByTagName("tbody")(0).getElementsByTagName("tr")(5). _
getElementsByTagName("td")(1).getElementsByTagName("font")(0). _
getElementsByTagName("input")(0).Value = "intRow"
Application.Wait DateAdd("s", 2, Now)
End With
End If
Next
End Sub
According to your code and the website, it seems that you want to open multiple tab (with the same URL), and then fill a value in the text box. We should pay attention to the following point:
How to access the web page elements.
How to switch tabs and focus to the new tab.
To access the web page elements, from your web page resource (use F12 developer tools to check it), I notice that the table contains 6 rows, but the last row doesn't contain the input element. So, using your code, I can't find the input element. I found that the input elements contain the class property. So, I suggest you could use the getElementsByClassName method to find the element.
To switch the IE browser tab, we could loop through the opened tabs and compare the URL, and then set focus on the related tab.
More detail steps, please check the following sample code:
Sub Test1()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
Dim intRow As Integer
For intRow = 1 To 3
If intRow = 1 Then
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI/jsp/patentes/PatenteSearchBasico.jsp"
Do While IE.Busy Or IE.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
IE.document.getElementsByClassName("basic")(0).Value = "intRow" & intRow
Application.Wait DateAdd("s", 3, Now)
End With
Else
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI/jsp/patentes/PatenteSearchBasico.jsp", 2048&
Do While IE.Busy Or IE.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Application.Wait DateAdd("s", 3, Now)
Set IE = GetIE("https://gru.inpi.gov.br/pePI/jsp/patentes/PatenteSearchBasico.jsp")
Application.Wait DateAdd("s", 3, Now)
IE.document.getElementsByClassName("basic")(0).Value = "intRow" & intRow
End With
End If
Next
End Sub
Function GetIE(sLocation As String) As Object
Dim retVal As Object
Dim my_url As String, my_title As String
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
'loop through the window and find the tab
For x = 0 To (IE_count - 1)
On Error Resume Next
'get the location and title
my_url = objShell.Windows(x).document.Location
my_title = objShell.Windows(x).document.Title
'debug to check the value
Debug.Print x
Debug.Print my_url
'find the special tab based on the title.
If my_url Like sLocation Then
Set retVal = objShell.Windows(x)
'IE.Quit 'call the Quit method to close the tab.
'Exit For 'exit the for loop
Else
End If
Next
Set GetIE = retVal
End Function
After running the above script, it will open three tabs and fill a value in the Login input text. Please see the following screenshot:
Reference:
Common VBA Methods & Properties used in web automation
I'm new here and on VBA, it's my 2nd post and I don't speak english very well. So, please, take easy on me =D
Last week I was having some troubles trying to automatize some procedures on IE. My macro worked very well when opened on new windows, but when I tried to run the same macro on tabs it wasn't working. It seemed (maybe) the macro wasn't recognizing the actual tab. I post that problem here and a wonderfull guy called Deepak-MSFT helped me a lot. He taught me how to run the macro on tabs and it worked almost 100%.
Problems:
1 - The macro sometimes work, sometimes doesn't. Yesterday, for example, I was getting errors 424, 91 and, sometimes, it just opened another tab without insert the value (perheaps because of the "On Error Resume Next"). I think it was because one of the websites was slow. I tried to increase the TimeValue until 7 seconds but, even so, it didn't work. I tested during the whole day and it was extremely unstable, sometimes worked, and somtimes it doesn't. But today it's working (all the websites are stable). Any idea how to solve this instability?
2 - There are 2 websites (2nd and 3rd) where I use querySelector to find the box to insert the value. Both of them work on 70% of the PC's of my company and only those 2 websites doesn't work on the other 30%. I installed the same version of IE (11.0.9600), Excel (2007, SP3) and Windows (W7) on all of them, but even so, only those 2 websites with queryselector don't work. There are no errors. The macro just don't insert the value. Perhaps I'm missing something that make queryselector works on those PC's, but all the references match. I dig the first 5 pages on google trying to find a solution but I failed. I think there's a witch flying around those PC's. Could you help me?
3 - I have total instability trying to run my macros on Excel 2016 or other versions of Excel higher than 2007 at Windows 10. Does anyone have a good solution to adapt the program to run on Excel 2016 (all my company will run this version next year) without have to do all over again?
Thank you very much guys. Here is my code:
Sub ademo()
Dim i As Long
Dim URL As String
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'TAB 1
URL = "https://servicos.ibama.gov.br/ctf/publico/areasembargadas/ConsultaPublicaAreasEmbargadas.php"
IE.Navigate2 URL
Do While IE.readyState = 4: DoEvents: Loop 'Do While
Do Until IE.readyState = 4: DoEvents: Loop 'Do Until
IE.document.getElementById("num_cpf_cnpj").Value = "demo1" 'Sheets("Main").Range("C10")
IE.document.getElementById("Emitir_Certificado").Click
'TAB 2 - DAP
On Error Resume Next
IE.Visible = True
IE.Navigate2 "http://smap14.mda.gov.br/extratodap/", 2048&
Application.Wait (Now + TimeValue("0:00:04"))
Set IE = GetIE("http://smap14.mda.gov.br/extratodap/")
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
On Error Resume Next
Set Target = IE.document.querySelector("#corpo > div > div > div:nth-child(1) > button")
Target.Click
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
doc.getElementById("txtCPF_CNPJ").Value = "demo2"
'TAB 3 - CNDT
IE.Visible = True
On Error Resume Next
IE.Navigate2 "http://aplicacao.jt.jus.br/cndtCertidao/inicio.faces", 2048&
Application.Wait (Now + TimeValue("0:00:04"))
Set IE = GetIE("http://aplicacao.jt.jus.br/cndtCertidao/inicio.faces")
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
On Error Resume Next
Set target2 = IE.document.querySelector("#corpo > div > div:nth-child(2) > input:nth-child(1)")
target2.Click
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
doc.getElementById("gerarCertidaoForm:cpfCnpj").Value = "demo3"
'TAB 4 - CND
On Error Resume Next
IE.Visible = True
IE.Navigate2 "http://servicos.receita.fazenda.gov.br/Servicos/certidao/CNDConjuntaInter/InformaNICertidao.asp?tipo=2", 2048&
Application.Wait (Now + TimeValue("0:00:04"))
Set IE = GetIE("http://servicos.receita.fazenda.gov.br/Servicos/certidao/CNDConjuntaInter/InformaNICertidao.asp?tipo=2")
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
On Error Resume Next
IE.document.getElementsByName("NI")(0).Value = "demo4"
'TAB 5 - IMPROBIDADE
IE.Visible = True
IE.Navigate2 "http://www.cnj.jus.br/improbidade_adm/consultar_requerido.php?validar=form", 2048&
Application.Wait (Now + TimeValue("0:00:04"))
Set IE = GetIE("http://www.cnj.jus.br/improbidade_adm/consultar_requerido.php?validar=form")
IE.document.getElementById("num_cpf_cnpj").Value = "demo5"
End Sub
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
sURL = ""
On Error Resume Next 'because may not have a "document" property
'Check the URL and if it's the one you want then
' assign the window object to the return value and exit the loop
sURL = o.document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function
I wrote code in VBA a couple years ago to open a website in IE and fill in textboxes with data from an excel file. Unfortunately I am using windows 10 now and this program is not working anymore. It opens the website with no problem, but cannot transpose the data into the textboxes. It simply opens the website and stalls (no data is entered).
The program still works in IE in windows 7, without any problem. I tried multiple laptops with windows 10 and the problem reoccurs.
I honestly don't know how to fix this.
DoEvents
WebAddress = "CONFIDENTIAL URL HERE" & WebID & "&t="
Dim IE As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate WebAddress
IE.Visible = True
While IE.busy
DoEvents 'wait until IE is done loading page.
Wend
Application.Wait (Now + TimeSerial(0, 0, 4))
IE.Document.All("Response_123").Value = ThisWorkbook.Sheets("Sheet1").Range("B5")
The last line of code should transfer data from the excel file to the textbox in internet explorer, however nothing happens and the textbox remains blank. Do I need to change anything in my code to account for windows 10 IE?
You can see that your code was not written in an efficient way. For an alternative approach, You can refer example below which is working fine with Windows 10.
Dim IE As Object
Sub demo()
Application.ScreenUpdating = False
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "C:\Users\Administrator\Desktop\sample.html"
While IE.Busy
DoEvents
Wend
wait 1
IE.Document.getElementById("firstname").Value = ThisWorkbook.Sheets("Sheet1").Range("A1")
wait 1
IE.Document.getElementById("lastname").Value = ThisWorkbook.Sheets("Sheet1").Range("A2")
wait 1
IE.Document.getElementById("submit_btn").Click
IE.Quit
Set IE = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub wait(seconds As Long)
Dim endTime As Date
endTime = DateAdd("s", seconds, Now())
Do While Now() < endTime
DoEvents
Loop
End Sub
Output:
If we talk about your above posted code than you can try to put the break point on that line and try to debug the code. Check that Which value contained by Cell B5 and check whether that line get execute successfully or not. For testing purpose, try to assign static value to that textbox.
enter image description herei am trying to download an excel file(.xls) from a pop up in Internet explorer via vba code. Which has three options (Open / Save / Cancel). i know this question was asked by many i tried few and it didnt work. Could you guys help ? i am using IE 11 version. Below is my code :
CODE :
Sub Button1_Click()
Dim IE As Object
Set IE = New InternetExplorerMedium
With IE
.Visible = True
.Navigate
"http://home.tim.flextronics.com/timireptool/ItemTransfer/Default.aspx"
Do While .busy
DoEvents
Loop
Do While .readystate <> 4
DoEvents
Loop
End With
Set CPC = IE.document.getelementbyid("tbCPC")
CPC.Value = "ALC3"
Set ddlOwner = IE.document.getelementbyid("ddlOwner")
For i = 1 To ddlOwner.Options.Length
If ddlOwner.Options(i).Text = "Warehouse" Then
ddlOwner.selectedindex = i
Exit For
End If
Next i
Set butview = IE.document.getelementbyid("butView")
butview.Click
Do While IE.busy
DoEvents
Loop
Do While IE.readystate <> 4
DoEvents
Loop
Set butExcel = IE.document.getelementbyid("butExcel")
butExcel.Click
Do While IE.busy
DoEvents
Loop
<<WHERE I WANT TO DOWNLOAD FROM THE POP>>
End Sub
Suggest me a solution to OPEN/SAVE the file. Thanks.
I am trying to download a table of proprietary investments/positions/pricing from Nationwide. The code seems to do what I want, EXCEPT for producing an "object required" error when I attempt to select a particular account (click)
I thought I had the proper code to tell my macro to wait until IE was ready to go on, but clearly I am missing something.
In the code, the relevant line is highlighted. If I enter a STOP above the error line, I can wait until I "see" the link appear, then "continue" the code and it runs as expected.
Because this goes to my financial accounts, I cannot provide the user name and password to allow someone to replicate the exact problem, but here is the code, and the error message and highlight. Suggestions appreciated.
Option Explicit
'set Reference to Microsoft Internet Controls
Sub DownLoadFunds()
Dim IE As InternetExplorer
Dim sHTML
Const sURL As String = "https://www.nationwide.com/access/web/login.htm"
Const sURL2 As String = "https://isc.nwservicecenter.com/iApp/isc/app/ia/balanceDetail.do?basho.menuNodeId=12245"
Dim wsTemp As Worksheet
Set wsTemp = Worksheets("Scratch")
Set IE = New InternetExplorer
With IE
.Navigate sURL
.Visible = True 'for debugging
Do While .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Do While .Busy = True
DoEvents
Loop
'Login: User Name and Password "remembered" by IE
.Document.all("submitButton").Click
Do While .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Do While .Busy = True
DoEvents
Loop
'Select this account to show
.Document.all("RothIRA_#########").Click '<--Error at this line
Do While .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Do While .Busy = True
DoEvents
Loop
.Navigate sURL2
Do While .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Do While .Busy = True
DoEvents
Loop
Set sHTML = .Document.GetElementByID("fundByFundOnly")
With wsTemp
.Cells.Clear
.Range("a2") = sHTML.innertext
End With
.Quit
End With
Set IE = Nothing
End Sub
This is the error message:
This shows the highlighted line:
EDIT:
At Tim Williams suggestion, I added a loop to test for the presence of the desired element. This seems to work:
...
On Error Resume Next
Do
Err.Clear
DoEvents
Application.Wait (Time + TimeSerial(0, 0, 1))
.Document.getelementbyid("RothIRA_#########").Click
Loop Until Err.Number = 0
On Error GoTo 0
....
IE.Document.all("#RothIRA_....") is returning Nothing (null in more refined languages), so calling the Click method is causing the error.
Your code is the same as doing this:
Dim rothElement As Whatever
rothElement = IE.Document.all("#RothIRA_....")
rothElement.Click
...when you should do this:
Dim rothElement As Whatever
rothElement = IE.Document.all("#RothIRA_....")
If rothElement <> Nothing Then
rothElement.Click
End If
I suggest using the modern document.GetElementById method instead of the deprecated (if not obsolete) document.All API.
It's possible/likely that the page is using script to dynamically load some content or generate some layout after your "wait" loop has finished. That loop only waits until all linked content/resources have been loaded - it does not wait for scripts on the loaded page to finish, etc.
One approach is to loop your code waiting for the desired element to be rendered:
Const MAX_WAIT_SEC as Long = 5 'limit on how long to wait...
Dim t
t = Timer
Do While .Document.all("RothIRA_#########") Is Nothing
DoEvents
'or you can Sleep here
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop
'carry on...