Notifications
Clear all

Macro Excel VBA parou de funcionar ao trocar o navegador Internet Explorer pelo Microsoft EDGE

1 Posts
1 Usuários
0 Reactions
1,216 Visualizações
(@Anônimo)
Posts: 0
Topic starter
 

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. 

 

Erro na linha:

While IE.Busy: Wend

 

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

____________________________________________________

Editado pela Moderação. Motivo: Procure utilizar o botão Código (< >) sempre que for inserir código VBA ou Fórmulas.

 
Postado : 28/10/2022 11:56 am
Tags do Tópico