Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Código simples que parou de funcionar

A Web está aí, não há como negar. Ela é onipresente em praticamente toda operação eletrônica realizada nos dias de hoje. Como não podia ser diferente, o Excel, ferramenta máxima para analistas e profissionais das mais diversas áreas do mercado precisa estar alinhado com esta necesssidade. E ele está! Neste forum, o debate é focado em expor dúvidas, sugestões, modelos de código e exemplos de uso do Excel na Integração com tecnologias Web.
Wagner Morel
Manda bem
Manda bem
Mensagens: 107
Registrado em: Qua Nov 29, 2017 11:51 am
Localização: Fortaleza - CE

Código simples que parou de funcionar

Mensagem por Wagner Morel »

Prezados amigos e caro professor Tomás,

Boa tarde a todos!

Fiz um código muito bom que me atendia perfeitamente até o momento que começou a dá erro. Não entendo o que foi que ocorreu pois funcionava normalmente todos os dias e de uma hora para a outra começou a dar esse "ERRO DE AUTOMAÇÃO" conforme figura abaixo.

Uso a versão 11.0.9600.19724 do IE e o Excel 2007. Reafirmo: tudo funcionava perfeitamente bem. Meu código faz acesso, pelo IE, a uma página da intranet da empresa que trabalho, insere login e senha (que digito em uma formulário e gravo os mesmos em variáveis Globais ao projeto) e depois é que vai buscar os dados necessários para montar meu relatório. O código não passa mais nem desse acesso inicial onde forneço o login e senha. Quando clico no botão depurar acima, o VBA destaca a seguinte linha:

Vou inserir todo o código aqui na tentativa de melhorar a compreensão de todos e ampliar uma possibilidade de me ajudarem pois não sei mais o que fazer. Já pesquisei na internet em todos os lugares e não achei solução para esse problema. Preciso muito de que isso dê certo. Por favor, me ajudem!

Segue abaixo o código - PRIMEIRA PARTE:

Código: Selecionar todos

Sub Fazer_Login_no_S522()

    Dim Linha As Long

    Dim URL_Login As String

    Dim TabelaLogin As Variant

    Dim TrLogin As Variant

    Dim TbLogin As Variant

    Dim CxNome As Variant

    Dim TrSenha As Variant

    Dim Bt As Variant

   

    'Atribui a URL que abre o navegador

    URL_Login = "http://s1wlbp04.capgv.intra.bnb/S522-CentralRetaguarda/Login.jsp"

   

    'Atribui a variável de objeto o objeto do Internet Explore

    Set oBrowser = New InternetExplorer

   

    'Configurações do objeto internet

    oBrowser.Silent = True

   

    'oBrowser.timeout = 60

    oBrowser.Navigate URL_Login

   

    'Torna o Internet Explore (página dos processos Concluídos visíveis

    oBrowser.Visible = True

   

    'Laço para permitir carregar todos os dados do relatório

    Do

    Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE 'Não passa dessa linha

   

    'Atribui a variável objeto a página aberta

    Set HTMLDoc = oBrowser.Document

   

    'Atribui a variável o conteúdo do corpo existente com as tabelas

    Set TabelaLogin = HTMLDoc.getElementsByTagName("body")(0)

   

    'Atribui a variável o conteúdo da segunda tabela

    Set TbLogin = TabelaLogin.getElementsByTagName("table")(1)

   

    'Atribui a variável o conteúdo da primeira linha

    Set TrLogin = TbLogin.getElementsByTagName("tr")(0)  'Nome

   

    'Atribui a variável o conteúdo da segunda linha

    Set TrSenha = TbLogin.getElementsByTagName("tr")(2) 'Senha

   

    'Insere o campo Nome o nome do usuário

    HTMLDoc.all.Item("j_username").Value = NomeLogin '(variável global que vem do userform que criei para entrar com Login e senha)

   

    'Insere o campo Senha a senha do usuário

    HTMLDoc.all.Item("j_password").Value = SenhaLogin '(variável global que vem do userform que criei para entrar com Login e senha)

   

    'Clica no botão Login

    oBrowser.Document.all.Item("login").Click

   

    'Pausar para esperar o carregamento

    Application.Wait (Now + TimeValue("00:00:02"))

   

    Set oBrowser = Nothing

    Set HTMLDoc = Nothing

    Set TabelaLogin = Nothing

    Set TbLogin = Nothing

    Set TrLogin = Nothing

    Set TrSenha = Nothing

   

    'Chama a rotina que busca os dados dos processos concluídos no S522

    Call Carrega_Dados_do_S522

End Sub
SEGUNDA PARTE:

Código: Selecionar todos

Sub Carrega_Dados_do_S522()

    '=====================================================================================

    'Necessita das referências MICROSOFT INTERNET CONTROLS e MICROSOFT HTML OBJECT LIBRARY

    '=====================================================================================

   

    'Cria as variáveis

    Dim sURL As String

    Dim i As Long

    Dim elemCollection As Object

    Dim UltimaLinha As Long

    Dim conteudoTbody As Variant

    Dim divTr As Variant

    Dim divTd As Variant

    Dim tagA As Variant

    Dim Linha As Long

    Dim NomeAnalista As String

    Dim conteudoTbody2 As Variant

    Dim divTr2 As Variant

    Dim divTd2 As Variant

    Dim j As Long

    Dim NomeCliente As String

    Dim TabelaTP As Variant

    Dim TrTP As Variant

    Dim Tipo As String

    Dim QtdeDemandas As Integer

    Dim TdValor As Object

    Dim Val As Object

    Dim Valor As Double

    Dim DtFechamento As Object

    Dim DataFechamento As Date

   

    'Atribui a URL que abre os Processos Concluídos. Já se deve ter entrado com Matrícula e Senha

    sURL = "http://s1wlbp04.capgv.intra.bnb/S522-CentralRetaguarda/faces/ConsultarHistorico.jsp"

   

    'Pausar para esperar o carregamento

    Application.Wait (Now + TimeValue("00:00:02"))

   

    'Armazena a última linha com dados pela coluna A

    Linha = Sheets("Todos").Cells(Cells.Rows.Count, 1).End(xlUp).Row

    If Linha < 2 Then

        Linha = 2

    Else

        Linha = Linha + 1

    End If

       

    'Atribui a variável de objeto o objeto do Internet Explore

    Set oBrowser = New InternetExplorer

   

    'Configurações do objeto internet

    oBrowser.Silent = True

    'oBrowser.timeout = 60

    oBrowser.Navigate sURL

   

    'Torna o Internet Explore (página dos processos Concluídos visíveis

    oBrowser.Visible = True

   

    'Laço para permitir carregar todos os dados do relatório

    Do

    Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE

   

    'Atribui a variável objeto a página aberta

    Set HTMLDoc = oBrowser.Document

   

    'Seleciona o campo Data Fechamento inicial

    HTMLDoc.getElementById("formPrincipal:dataFechamentoInicio").Focus

   

    'Atribui a data atual do dia ao campo selecionado

    HTMLDoc.getElementById("formPrincipal:dataFechamentoInicio").Value = Format(DataInícioFechamento, "dd/mm/yyyy")

   

    'Seleciona o campo Data Fechamento final

    HTMLDoc.getElementById("formPrincipal:dataFechamentoFim").Focus

   

    'Atribui a data atual do dia ao campo selecionado

    HTMLDoc.getElementById("formPrincipal:dataFechamentoFim").Value = Format(DataFimFechamento, "dd/mm/yyyy")

   

    'Seleciona o´item "Concluídas" no combo situação

    HTMLDoc.getElementById("formPrincipal:situacaoSolicitacao").selectedIndex = 1

   

    'Clica no botão BUSCAR

    HTMLDoc.all("formPrincipal:btBuscar").Click

   

    'Pausar para esperar o carregamento

    Application.Wait (Now + TimeValue("00:00:02"))

   

    'Seleciona a tabela de solicitações

    Set elemCollection = HTMLDoc.getElementById("formPrincipal:tableSolicitacao")

   

    '=========================================================================================================

    'Busca na Tag 9, nomeada por "tbody", alusiva a Lista de Solicitações, por cada um dos links para abrir _

    os mesmos e pegar os demais dados das demandas

    '=========================================================================================================

   

    'Atribui à variável o nome da Tag (tabela aonde estão as solicitações

    Set conteudoTbody = HTMLDoc.getElementsByTagName("tbody")(9)

    Set divTr = conteudoTbody.getElementsByTagName("tr")(0)

   

    'Armazena a quantidade de demandas existentes

    QtdeDemandas = conteudoTbody.getElementsByTagName("tr").Length


    'Laço para percorrer cada um dos links da Lista de solicitações

    For i = 0 To conteudoTbody.getElementsByTagName("tr").Length - 1

        'Coloca o ícone de espera para o cursor do mouse

        Application.Cursor = xlWait

        'Insere aviso no formulário para saber o que está sendo copiado

        Frm_Principal.Lbl_Aviso.Caption = "Aguarde... Copiando Dados Cliente " & i + 1 & " de " & QtdeDemandas & "!"

        'Atribui à variável o nome da Tag (tabela aonde estão as solicitações

        Set conteudoTbody = HTMLDoc.getElementsByTagName("tbody")(9)

        'Atribui à variável o nome da primeira Tag Tr dentro da lista de solicitações

        Set divTr = conteudoTbody.getElementsByTagName("tr")(i)

        'Atribui à variável o nome da primeira Tag td, primeira linha dentro da lista de solicitações

        Set divTd = divTr.getElementsByTagName("td")(0)

        'Armazena o nome do cliente

        NomeCliente = divTr.getElementsByTagName("td")(2).innerText

        'Atribui à variável o nome da primeira Tag a, cada um dos Links dentro da lista de solicitações

        Set tagA = divTd.getElementsByTagName("a")(0)

        'Efetua o click no link

        tagA.Click

       

        '=========================================================================================================

        'FIM do Bloco de Busca dos links das demandas

        '=========================================================================================================

       

        'Aguarda 2 segundos enquanto a página de mais dados abre o link

        Application.Wait (Now + TimeValue("00:00:02"))

       

        'Armazena o tipo de demanda

        Set TabelaTP = HTMLDoc.getElementsByTagName("tbody")(7)

        Set TrTP = TabelaTP.getElementsByTagName("tr")(6)

        Tipo = TrTP.innerText

        Tipo = Trim(Tipo)

        Tipo = Right(Tipo, 3)

       

        If Tipo = "CIC" Or Tipo = "MAP" Then

            'Atribui à variável o conteúdo do corpo da tabela onde se encontra as Ocorrências

            Set conteudoTbody2 = HTMLDoc.getElementsByTagName("tbody")(13)

        Else

            'Atribui à variável o conteúdo do corpo da tabela onde se encontra as Ocorrências

            Set conteudoTbody2 = HTMLDoc.getElementsByTagName("tbody")(10)

        End If


        'Atribui à variável o conteúdo da tabela onde se encontra as Ocorrências

        Set divTr2 = conteudoTbody2.getElementsByTagName("tr")

       

        'Armazena a data de fechamento na variável de objeto

        Set DtFechamento = HTMLDoc.getElementById("form2:textFechamento")

        'Transforma na data e armazena na variável Data

        DataFechamento = CDate(DtFechamento.innerText)

       

        'Laço para percorrer todas as linhas da tabela de ocorrências e descobrir qual é a última linha

        For j = 0 To divTr2.Length - 1

            'Atribui à variável o conteúdo da tabela onde se encontra as Ocorrências

            Set divTr2 = conteudoTbody2.getElementsByTagName("tr")

           

            'Armazena o valor

            If Trim(Tipo) <> "ROC" And Trim(Tipo) <> "PRD" And Trim(Tipo) <> "POA" And Trim(Tipo) <> "PAR" And Trim(Tipo) <> "CIC" And Trim(Tipo) <> "MAP" And Trim(Tipo) <> "LCC" Then

                Set Val = HTMLDoc.getElementById("form2:viewFragment19:lrcoutputVlrCredito")

                Valor = CDbl(Val.innerText)

            ElseIf Trim(Tipo) = "CIC" Then

                Set Val = HTMLDoc.getElementById("form2:viewFragment19:valorInput")

                Valor = CDbl(Val.DefaultValue)

            ElseIf Trim(Tipo) = "LCC" Then

                Set Val = HTMLDoc.getElementById("form2:viewFragment20:lrcoutputVlrCredito")

                Valor = CDbl(Val.innerText)

            End If

           

            'Verifica se já chegou a última linha

            If j = divTr2.Length - 1 Then

                'Atribui à variável os dados da última linha encontrada

                Set divTr2 = conteudoTbody2.getElementsByTagName("tr")(j)

                'Atribui a variável o conteúdo da coluna 3 da última linha (Responsável pela ocorrência)

                Set divTd2 = divTr2.getElementsByTagName("td")(3)

                'Atribui a varável o nome do analista, passando a função que descobre qual é o nome do mesmo _

                pela matrícula encontrada

                NomeAnalista = Trim(NomeFuncionário(divTd2.innerText))

            End If

        Next j

       

        'Copia, para a planilha, na coluna A, a data de fechamento

        Sheets("Todos").Range("A" & Linha).Value = CDate(DataFechamento)

       

        'Copia para a planilha, na coluna B, a partir da linha 2, o nome do cliente

        Sheets("Todos").Range("B" & Linha).Value = NomeCliente

       

        'Copia para a planilha, na coluna C, a partrir da linha 2, o nome do analista encontrado

        Sheets("Todos").Range("C" & Linha).Value = Trim(NomeAnalista)

       

        'Copia para a planilha, na coluna D, a partrir da linha 2, o valor encontrado

        Sheets("Todos").Range("D" & Linha).Value = CDbl(Valor)

        Valor = 0


        'Incrementa a linha da planilha

        Linha = Linha + 1

       

        'Clica no botão "voltar para a Lista de processos" para pegar o próximo processo

        HTMLDoc.getElementById("form2:buttonVoltarTarefas").Click 'HTMLDoc.getElementsByClassName("button")(0).Click

       

        'Aguarda 2 segundos enquanto a página volta

        Application.Wait (Now + TimeValue("00:00:02"))

       

        Set conteudoTbody = Nothing

        Set divTr = Nothing

        Set divTd = Nothing

        Set tagA = Nothing

        Set conteudoTbody2 = Nothing

        Set divTr2 = Nothing

        Set TabelaTP = Nothing

        Set TrTP = Nothing

        Set Val = Nothing

    Next i

    'Encerra o navegador

    oBrowser.Quit

    'Coloca o ícone normal para o cursor do mouse

    Application.Cursor = xlDefault

    MsgBox "Relatório Importado com sucesso!", vbDefaultButton1, "RELATÓRIO DE PROCESSOS CONCLUÍDOS"

    Frm_Principal.Lbl_Aviso.Caption = ""

End Sub
Anexos
Depurador.png
Depurador.png (3.9 KiB) Exibido 4474 vezes
Erro de automação.png
Erro de automação.png (4.39 KiB) Exibido 4474 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Raygsson
Manda bem
Manda bem
Mensagens: 118
Registrado em: Sex Jan 31, 2020 8:06 pm

Re: Código simples que parou de funcionar

Mensagem por Raygsson »

Olá
Deve ter ocorrido alguma atualização na versão do Internet Explorer. Tenta declarar o objeto IE assim :
Dim IE As InternetExplorer
Set IE = New InternetExplorer
Ou assim:
Dim IE As InternetExplorerMedium
Set IE = New InternetExplorerMedium
Alguma dessas formas deve funcionar.
Att,
Raygsson


Raygsson
Manda bem
Manda bem
Mensagens: 118
Registrado em: Sex Jan 31, 2020 8:06 pm

Re: Código simples que parou de funcionar

Mensagem por Raygsson »

Acabei de ler o seu codigo, no caso tenta assim:

Dim oBrowser As InternetExplorerMedium
Set oBrowser = New InternetExplorerMedium


Wagner Morel
Manda bem
Manda bem
Mensagens: 107
Registrado em: Qua Nov 29, 2017 11:51 am
Localização: Fortaleza - CE

Re: Código simples que parou de funcionar

Mensagem por Wagner Morel »

Raygsson,

Boa noite!

Funcionou perfeitamente bem com a sua sugestão de mudar para InternetExploreMedium!!!. Cara não tenho palavras suficiente para lhe agradecer. Muito obrigado de coração. Você salvou o meu dia e o meu trabalho! Tem alguns dias que eu venho batendo cabeça sem conseguir resolver isso.

Uma curiosidade: Sabe me dizer porque isso ocorre? O porque dessa mudança?


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Raygsson
Manda bem
Manda bem
Mensagens: 118
Registrado em: Sex Jan 31, 2020 8:06 pm

Re: Código simples que parou de funcionar

Mensagem por Raygsson »

Que bom que funcionou.
Pelo que pesquisei essa alteração ocorre por mudança nas configurações de segurança.
Acesse o link abaixo, é bem explicativo.

https://www.it-swarm.dev/pt/internet-ex ... 069127108/


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder