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
___________________________________________________
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:03 am