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

[RESOLVIDO]Abrir página (web) e copiar os dados para uma planilha

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

[RESOLVIDO]Abrir página (web) e copiar os dados para uma planilha

Mensagem por Wagner.cwb »

Olá Colegas!

arrumei uma forma de capturar dados no navegador, porém estou com um desafio,

fazer o código "clicar" em "permitir o acesso" e voltar para continuar a execução do código.

A parte do código que preciso desse intervalo é:

Código: Selecionar todos

With app
    'Selects the full website and copies the contents
    .Document.execCommand "SelectAll", False
    .Document.execCommand "copy", False 'aqui para na imagem em anexo, como clicar em permitir?
    End With
Na parte do .Document.execCommand "copy", False o código dá erro de tempo de execução

Tem como eu criar comandos múltiplos nessa linha?
.Document.execCommand "copy"

e incluir o famigerado "ok"

Estou quebrando a cabeça nisso faz um tempo, cada solução que encontro me deparo com pops que interrompem tudo rs

Obrigado! abs
Anexos
ok.PNG
ok.PNG (72.14 KiB) Exibido 6874 vezes
Editado pela última vez por Wagner.cwb em Ter Jul 11, 2017 10:15 pm, em um total de 1 vez.


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.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Tempo de espera "para decisão"

Mensagem por webmaster »

Está usando o que? IE? Selenium?


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Tempo de espera "para decisão"

Mensagem por Wagner.cwb »

IE Tomas


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Tempo de espera "para decisão"

Mensagem por Wagner.cwb »

Amigos, amigos!

encontrei uma solução, depois que arrancar muitos cabelos!! aahahahaha
Olha, veio da onde não esperava, pois era um forum japonês, http://club.excelhome.net/thread-473891-1-1.html , nem tradutor dava conta, mas o script falou por si :D , depois de pesquisar e pesquisar muitas soluções e nada, Deus mostra que a simplicidade também é solução.

Código: Selecionar todos

With app
    'Selects the full website and copies the contents
    .Document.execCommand "SelectAll", False
    .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
          
    End With

.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

Eu não sei exatamente que isso faz, mas salvou a lavoura.

Eu estava pesquisando uma saída via API, estudei uma forma de identificar janela ativa do IE e nada, mas não foi tempo perdido, serviu para aprender e compartilhar com vocês, caso necessitem!

Segue o código completo
Ele faz a autenticação, localiza uma tabela, abre a página html e copia os dados da página em uma planilha.

Eu recorri a este caminho, pois ainda não tenho domínio nos comandos para baixar o arquivo xls, digo manipular janela IE "salvar", "salvar como" e "cancelar".

Código: Selecionar todos

Sub BASE_OCUPADAS()

'http://www.excelforum.com/excel-programming-vba-macros/806831-solved-external-web-query-connection-to-login-automatically.html
'http://club.excelhome.net/thread-473891-1-1.html

Dim btnInput As Object ' MSHTML.HTMLInputElement
Dim ElementCol As Object ' MSHTML.IHTMLElementCollection

Dim IE As InternetExplorer
Dim C
Dim ULogin As Boolean, ieForm
Dim MyPass As String, MyLogin As String

Application.DisplayAlerts = False

MyLogin = ""
MyPass = ""

Set IE = New InternetExplorer ' Nova Página
IE.Visible = True

Mysite = "http://urapms.brasiltelecom.com.br/pms/"
IE.Navigate Mysite 'Acessar link
Do Until IE.READYSTATE = READYSTATE_COMPLETE 'Loop ate conectar na página
Loop

    IE.Document.all("j_username").innerText = MyLogin
    IE.Document.all("j_password").innerText = MyPass
    'obtém o forma a qual o controle de login pertence para submetê-lo
    IE.Document.forms(0).submit
'IE.Document.all("login_txt").innerText = MyLogin 'Colocar Usuário
'IE.Document.all("senha_txt").innerText = MyPass 'Colocar Senha
'IE.Document.all("submit").Click 'Clicar para acessar
Do Until IE.READYSTATE = READYSTATE_COMPLETE 'Loop ate conectar na página
Loop
Sleep (1000)

Mysite = "http://urapms.brasiltelecom.com.br/pms/relatorio/disponivel/listar-disponiveis.jsp"
IE.Navigate Mysite
Do Until IE.READYSTATE = READYSTATE_COMPLETE 'Loop ate conectar na página
Loop
hoje = Format(Now, "dd/mm/yyyy")
ontem = Format(Now - 1, "dd/mm/yyyy")

    IE.Document.all("dtInicio").innerText = ontem
    IE.Document.all("dtFim").innerText = hoje
    IE.Document.all("nomeArquivo").innerText = "POP"
       
   IE.Document.forms(0).submit

Sleep (5000)

 Dim idaux As String
 
 Do While IE.READYSTATE <> 4
   Loop
    With IE
        .Navigate URL
        .Visible = True
        Do Until .READYSTATE = READYSTATE_COMPLETE: DoEvents: Loop
        Set htmlDoc = .Document
    End With

'identificar arquivo atual html

    With htmlDoc
        'Target the set of tables.
        Set tblSet = .GetElementById("listagem")
        Set mTbl = tblSet.getElementsByTagName("a")(3)
        tTbl = VBA.Right(mTbl, 9) 'id tabela html atual
        idaux = VBA.Right(mTbl, 6) 'auxiliar
    End With
           
    Dim a As String
    Set app = CreateObject("InternetExplorer.Application")
    With app
        .Visible = True
        .Navigate "http://urapms.brasiltelecom.com.br/pms/RelatorioDisponivelViewServlet?" & tTbl
        Do Until .READYSTATE = 4
            DoEvents
        Loop
    End With
    
    
  'Application.EnableEvents = False
 
  'Aqui seu código
 
'  Application.EnableEvents = True

    'SELECIONAR E COPIAR DADOS DA PAGINA
    With app
    'Selects the full website and copies the contents
    .Document.execCommand "SelectAll", False
    .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
          
    End With
    
    app.Quit
    'ABRIR PLANILHA DESTINO
    
    Workbooks.Open filename:="\\km3rede\aplcopel\Relacionamento_Clientes\ISOAcesso\Relatórios\Acompanhamento Diário\Diario\TESTE_WAGNER\base_ocupadas.xlsx" 'Abrindo planilha destino
            
    Worksheets(1).Activate
    Worksheets(1).Cells.ClearContents
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
        False
    ActiveSheet.Cells.WrapText = False
    ActiveSheet.Cells.MergeCells = False
    
    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    Rows("1:1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
    ActiveWorkbook.SaveAs filename:="\\km3rede\aplcopel\Relacionamento_Clientes\ISOAcesso\Relatórios\Acompanhamento Diário\Diario\TESTE_WAGNER\base_ocupadas.xls", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    Workbooks("base_ocupadas.xls").Close
    

       Application.DisplayAlerts = True
IE.Quit
Set IE = Nothing




End Sub



Abs

Wagner


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.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: [RESOLVIDO]Abrir página (web) e copiar os dados para uma planilha

Mensagem por webmaster »

Gostei de ver! Valeu por compartilhar!


RogérioC
Acabou de chegar
Acabou de chegar
Mensagens: 9
Registrado em: Qui Jun 25, 2020 5:35 pm

Re: [RESOLVIDO]Abrir página (web) e copiar os dados para uma planilha

Mensagem por RogérioC »

Eu preciso copiar a URL de um link da web mas não consigo. Utilizo o Chrome.


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