VBA Automation (macro) isn't working very well on IE tabs

ⅰ亾dé卋堺 提交于 2019-12-24 17:18:50

问题


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

来源:https://stackoverflow.com/questions/59273161/vba-automation-macro-isnt-working-very-well-on-ie-tabs

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!