Macro VBA parou de funcionar com Microsoft EDGE

[maritaca88]

Bom dia pessoal.

Essa macro rodava no Internet Explorer, mas com sua descontinuação e substituição pelo Microsoft EDGE, parou de funcionar. Poderiam me ajudar a corrigi-la/atualiza-la?

Abaixo a macro depurada e anexos as msgs de erro.

Desde já agradeço!

Dim IE

Dim docweb

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub CapturarDados()

   

    frm_login.Show

   

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True

   

    IE.Navigate2 URL:="https://scr.bcb.gov.br/scr/"

   

    Espera

   

    Sleep 2000

   

    'docweb.all.UserNameinput.Value = frm_login.txt_IIIIIDDDD.OPERADOR.Value

    '  docweb.all.passwordinput.Value = frm_login.txt_senha.Value

    'docweb.all.submitbutton.Click

   

    Espera

   

'    If docweb.getElementsByTagName("table")(2).Rows(0).Cells(0).innerText = "Acesso " Then

'        MsgBox "Dados de identificação inválidos.Encerrando operação"

'        IE.Quit

'        End

'    End If

   

    'Call docweb.frames("superior").document.parentWindow.execScript("retAm(1)", "JavaScript")

 

    'IE.Navigate2 URL:="https://www3.bcb.gov.br/scr/scr?visaoId=crc.operacional.aplicacao.informacoes.consolidadas.VisaoConsultaInformacoesConsolidadas&comando=acaoMostrarPaginaInicial"

 

    IE.Navigate2 URL:="https://scr.bcb.gov.br/scr/consulta"

   

    Espera

   

'    IE.Navigate2 URL:="https://www3.bcb.gov.br/scr"

'

'    Espera

   

    primeiro = True

   

    lin = 3

    cpf = Plan1.Cells(3, 2)

   

    If Plan1.Cells(3, 1) = "" Then

        If Len(cpf) <= 11 Then

            tipo = 1

        Else

            tipo = 2

        End If

    Else

        tipo = CInt(Trim(Plan1.Cells(3, 1)))

    End If

   

    While cpf <> ""

        CAC = 0

        VC = 0

        CATotal = 0

        VTotal = 0

       

        cpf = Replace(Replace(Replace(cpf, ".", ""), "/", ""), "-", "")

       

        If tipo <> 1 And tipo <> 2 Then

            tam = Len(cnpj)

            If tam <= 8 Then

                cpf = Right("00000000" & cpf, 8)

                tipo = 2

            ElseIf Len(cpf) <= 11 Then

                cpf = Right("00000000" & cpf, 8)

                tipo = 1

            Else

                cpf = Left(Right("00000000000000" & cpf, 8), 14)

                tipo = 2

            End If

        Else

            If tipo = 1 Then

                cpf = Right("00000000000" & cpf, 11)

            ElseIf tipo = 2 Then

                cpf = Left(Right("00000000000000" & cpf, 14), 8)

            End If

        End If

   

        Sleep 500

   

        docweb.getElementsByName("clientePanel:codigoCliente").Item.innerText = cpf

        docweb.getElementsByName("clientePanel:tipoCliente").Item.Value = tipo

       

        mes = frm_login.cmb_mes.Text

       

        Dim mesAtual, anoAtual, itemAdicionar

        mesAtual = Month(Now())

        anoAtual = Year(Now())

 

        For i = 0 To 13

            mesAtual = mesAtual - 1

            If mesAtual = 0 Then

                mesAtual = 12

                anoAtual = anoAtual - 1

            End If

           

            itemAdicionar = Right("00" & mesAtual, 2) & "-" & anoAtual

           

            If mes = itemAdicionar Then

                mesano = i

                i = 13

            End If

        Next

       

        docweb.getElementsByName("codigoDataBase").Item.Value = mesano

       

        'capturar dados Totais (Caixa e demais instituições)

       

        If primeiro Then

            docweb.getElementsByName("autorizacao").Item.Click

            primeiro = False

        End If

       

        docweb.getElementsByName("botao2").Item.Click

       

        Espera

       

        msgSpanErro = Trim(docweb.getElementsByTagName("span")(7).innerText)

       

        If msgSpanErro = "CNPJ inválido: Favor digitar um CNPJ com 8 dígitos (XXXXXXXXX)." Then

            Plan1.Cells(lin, 3) = "CNPJ Inválido. Favor verificar."

            GoTo proximo

        Else

            docweb.getElementsByName("Sim").Item.Click

            Espera

        End If

       

        msgTexto1 = docweb.getElementsByTagName("table")(1).Rows(0).Cells(0).innerText

        msgTexto0 = docweb.getElementsByTagName("table")(0).Rows(0).Cells(0).innerText

       

        If msgTexto1 = "O cliente não foi encontrado na data-base desejada " Or msgTexto1 = "Não foram encontrados dados para o cliente, para os critérios abaixo relacionados" Then

            Plan1.Cells(lin, 3) = "NÃO TOMADOR DE CRÉDITO"

            docweb.getElementsByName("botaoVoltar").Item.Click

            Espera

            GoTo proximo

        ElseIf msgTexto0 = "Página de Erro" Then

            MsgBox "Indisponível  no momento. Aguarde um instante e tente novamente. "

            docweb.getElementsByTagName("Input")(0).Click

            Espera

            IE.Quit

            End

        End If

       

        'docweb.all("Yeah").Click

       

'        docweb.getElementsByTagName("a")(0).Click

'        Espera

       

        nome = docweb.getElementsByTagName("table")(1).Rows(0).Cells(1).innerText

        dataBase = docweb.getElementsByTagName("table")(1).Rows(1).Cells(1).innerText

        CATotal = docweb.getElementsByTagName("table")(2).Rows(3).Cells(3).innerText

        VTotal = docweb.getElementsByTagName("table")(2).Rows(12).Cells(4).innerText

        PTotal = docweb.getElementsByTagName("table")(2).Rows(19).Cells(4).innerText

       

        'Plan1.Cells(lin, 3) = Right(nome, Len(nome) - 17)

        Plan1.Cells(lin, 4) = dataBase

        Plan1.Cells(lin, 6) = CATotal

        Plan1.Cells(lin, 9) = VTotal

        Plan1.Cells(lin, 11) = PTotal

              

        'voltar

        docweb.getElementsByName("voltar").Item.Click

        Espera

       

        'Capturar dados sobre caixa

        docweb.getElementsByTagName("input")(3).Click

        Espera

       

        Dim msgTRC

        msgTRC = Trim(docweb.getElementsByTagName("table")(1).Rows(0).Cells(0).innerText)

       

        If msgTRC = "Cliente não encontrado na data-base" Or msgTRC = "O cliente não foi encontrado na data-base desejada" Or msgTRC = "Não foram encontrados dados para o cliente, para os critérios abaixo relacionados" Then

            Plan1.Cells(lin, 5) = 0

            Plan1.Cells(lin, 8) = 0

            docweb.all("botaoVoltar").Click

            Espera

            GoTo proximo

        End If

       

'        docweb.getElementsByTagName("a")(0).Click

'        Espera

       

'        docweb.getElementsByName("Sim").Item.Click

'       Espera

               

        CAC = docweb.getElementsByTagName("table")(2).Rows(3).Cells(3).innerText

        VC = docweb.getElementsByTagName("table")(2).Rows(12).Cells(4).innerText

        

        'GRAVAR DADOS CAPTURADOS

        Plan1.Cells(lin, 5) = CAC

        Plan1.Cells(lin, 8) = VC

       

       'Demais instituições

        Plan1.Cells(lin, 7) = CDbl(CATotal) - CDbl(CAC)

        Plan1.Cells(lin, 10) = CDbl(VTotal) - CDbl(VC)

       

        'Voltar

        docweb.getElementsByName("voltar").Item.Click

        Espera

       

proximo:    lin = lin + 1

            cpf = Plan1.Cells(lin, 2)

            If Trim(Plan1.Cells(lin, 1)) <> "" Then

                tipo = CInt(Trim(Plan1.Cells(lin, 1)))

            Else

                tipo = 0

            End If

    Wend

   

    IE.Quit

    MsgBox "Operação Concluida."

    frm_login.txt_unidade.Value = ""

    'frm_login.txt_dependencia.Value = ""

    'frm_login.txt_operador.Value = ""

    frm_login.txt_senha.Value = ""

   

End Sub

 

Sub Espera()

    '****************************

    While IE.Busy: Wend

    While IE.document.ReadyState <> "complete": DoEvents: Wend

    'While IE.Document.ReadyState <> "complete": DoEvents: Wend

    'While IE.Document.ReadyState <> "complete": DoEvents: Wend

    Set docweb = IE.document 'lê o objeto

    '****************************

End Sub