Ir para conteúdo
Fórum Script Brasil

maritaca88

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Tudo que maritaca88 postou

  1. 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
×
×
  • Criar Novo...