Ir ao conteúdo
  • Cadastre-se
Regras do Clube do Hardware

Excel macro para exportar e atualizar planilha de site com acesso através de log/senha

Murilo_Correa

Por Murilo_Correa
em Microsoft Office e similares

 Compartilhar
Ir à solução Resolvido por Basole,

Posts recomendados

Basole
 

Basole

Postado
Postado

voce selecionou o campo SOLICITAR RERISTRO DO PIN DA NF DE IMPORTACAO.

 

Vamos tentar pelo ID.  Que é a primeira linha e primeira coluna com dados, da tabela, acredito que nesta linha está a informação que preciso.

Quando encontrar, coloque  o cursor, e na tabela, o campo, deverá ficar destacado, é esse item que deverá copiar.

 

  

Link para o comentário
Compartilhar em outros sites
Murilo_Correa
 

Murilo_Correa

Postado
  • Autor
Postado
19 minutos atrás, Basole disse:

voce selecionou o campo SOLICITAR RERISTRO DO PIN DA NF DE IMPORTACAO.

 

Vamos tentar pelo ID.  Que é a primeira linha e primeira coluna com dados, da tabela, acredito que nesta linha está a informação que preciso.

Quando encontrar, coloque  o cursor, e na tabela, o campo, deverá ficar destacado, é esse item que deverá copiar.

 

  

Desculpe entendi errado.

 

Segue Xpath do ID; 

//*[@id="content"]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[1]/th[1]

image.thumb.png.8e3473166da04fa3ddb44b4ced150976.png

Link para o comentário
Compartilhar em outros sites
Basole
 

Basole

Postado
Postado

Experimente....

Acrescente a linhas abaixo no codigo:

  

Dim tabItems As WebElements
Dim Item As WebElements
    
    Set tabItems = .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[1]/th[1]")
    
    Debug.Print tabItems.Count

    For Each Item In tabItems
       MsgBox Item.Text
    Next Item

 

Link para o comentário
Compartilhar em outros sites
Murilo_Correa
 

Murilo_Correa

Postado
  • Autor
Postado
30 minutos atrás, Basole disse:

Experimente....

Acrescente a linhas abaixo no codigo...

 

o código ficou da seguinte forma. 

Sub Login_Suframa()
 Dim driver As New ChromeDriver

    With driver
    .Get "https://simnac.suframa.gov.br"
    .FindElementByName("usuario").SendKeys ("") 
    .FindElementByName("senha").SendKeys ("")  
    .Wait (1000)
    .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
    .Wait (5000)
    .FindElementByXPath("//*[@id=""content""]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/header/h2/div/button", 5).Click
    .Wait (5000)
    
    Dim tabItems As WebElements
Dim Item As WebElements
    
    Set tabItems = .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[1]/th[1]")
    
    Debug.Print tabItems.Count

    For Each Item In tabItems
       MsgBox Item.Text
    Next Item
    End With
End Sub

Porém retornou o seguinte erro.

image.png.1dd30cd74dc81938eccf632ec53285a3.png

image.png.5d166bbccb05773320f9a775e3539319.png

Link para o comentário
Compartilhar em outros sites
Basole
 

Basole

Postado
Postado

@Murilo_Correa boa tarde,

Experimente as alterações :

O ultimo comando importa todos os dados da tabela para uma nova aba que é criada na sua planilha.

* Na tabela (conf. imagens que enviou anterirmente), os dados estão fora de tabulação.

Acho que o ideal é fazer um loop atraves das celulas trazendo dado-a-dado.

De qualquer forma teste ai e vamos ajustando: 

  

Sub Login_Suframa()
    Dim driver      As New ChromeDriver
    Dim tblItems    As Selenium.TableElement

    With driver
        .Get "https://simnac.suframa.gov.br"
        .FindElementByName("usuario").SendKeys ("")
        .FindElementByName("senha").SendKeys ("")
        .Wait (1000)
        .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
        .Wait (5000)

        ' Exportar a planilha:
        ' .FindElementByXPath("//*[@id=""content""]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/header/h2/div/button", 5).Click
        .Wait (5000)

        Set tblItems = .FindElementByXPath("(.//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table)[1]").AsTable

    End With
    With ThisWorkbook
        .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo"
        tblItems.ToExcel .ActiveSheet.Range("A1")
    End With

End Sub

 

 

 

Link para o comentário
Compartilhar em outros sites
Murilo_Correa
 

Murilo_Correa

Postado
  • Autor
Postado
1 hora atrás, Basole disse:

@Murilo_Correa boa tarde,

Experimente as alterações :

O ultimo comando importa todos os dados da tabela para uma nova aba que é criada na sua planilha.

* Na tabela (conf. imagens que enviou anterirmente), os dados estão fora de tabulação.

Acho que o ideal é fazer um loop atraves das celulas trazendo dado-a-dado.

De qualquer forma teste ai e vamos ajustando: 

  

Sub Login_Suframa()
    Dim driver      As New ChromeDriver
    Dim tblItems    As Selenium.TableElement

    With driver
        .Get "https://simnac.suframa.gov.br"
        .FindElementByName("usuario").SendKeys ("")
        .FindElementByName("senha").SendKeys ("")
        .Wait (1000)
        .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
        .Wait (5000)

        ' Exportar a planilha:
        ' .FindElementByXPath("//*[@id=""content""]/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/header/h2/div/button", 5).Click
        .Wait (5000)

        Set tblItems = .FindElementByXPath("(.//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table)[1]").AsTable

    End With
    With ThisWorkbook
        .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo"
        tblItems.ToExcel .ActiveSheet.Range("A1")
    End With

End Sub

 

 

 

Cara, tu é demais, puxou todas as informações corretamente. Eu não entendi muito bem, ele puxou as informações da planilha que foi exportada do site? Ou ele já puxa diretamente do site as informações?

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
Basole
 

Basole

Postado
Postado
1 hora atrás, Murilo_Correa disse:

Cara, tu é demais, puxou todas as informações corretamente. Eu não entendi muito bem, ele puxou as informações da planilha que foi exportada do site? Ou ele já puxa diretamente do site as informações?

 

@Murilo_Correa obrigado!

 

Sim exatamente isso, puxa direto do site. O codigo copia o objeto tabela do site e com a função, que eu não conhecia, do selenium ToExcel cola os dados na aba.

 

Mas pena que os dados no site não são organizados como uma verdadeira tabela ou seja, fora de tabulação, isso atrapalha na hora fazer a programação, 

Mas eu ajustei o codigo abaixo, para percorrer todas as celulas da tabela do site e puxar os dados e inserir mais organizadamente possível e desconsiderando a primeira coluna que contem os numeros, pois contem celulas mescladas

 

* 1 - Esta tabela segue um padrão das demais consultas? 

* 2 - Insira ou ajuste os wait(s) no codigo, se necessario de acordo com o carregamento das paginas. 

* 3 -Se preferir da pra ajustar no codigo para o navegador chrome ficar com a tela invisivel.

  

Sub Login_Suframa_Por_Celulas()
    Dim driver      As New ChromeDriver
    Dim r           As Range
    Dim Row         As Object
    Dim body        As Object
    Dim cell        As Object
    Dim x: x = 1

    With driver
        .Get "https://simnac.suframa.gov.br"
        .Wait (1000)
        .FindElementByName("usuario").SendKeys ("USUARIO")    ' * USUARIO
        .FindElementByName("senha").SendKeys ("SENHA")   ' * SENHA
        .Wait (1000)
        .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
        .Wait (5000)

        ' adiciona nova aba:
        With ThisWorkbook
            .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo_1"
        End With
        .Wait (1000)

        For Each body In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody")
            For Each Row In body.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr")
                For Each cell In Row.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr[" & x & "]/td")
                    y = y + 1
                    If VBA.InStr(1, cell.Text, "TOTAL DE PENDÊNCIAS POR DIAS PARA EXPIRAÇÃO DO PRAZO") > 0 Then
                        y = 4: Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ")
                    Else
                        If VBA.IsNumeric(cell.Text) And y = 1 Then
                            Cells(x, y) = ""
                        ElseIf VBA.InStr(1, cell.Text, "Vistoria ") > 0 And y = 1 Then
                            y = 2
                            Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ")
                        Else
                            Cells(x, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ")
                        End If
                    End If
                Next cell
                ' efeito zebrado no intevalo de dados:
                If x Mod 2 <> 0 Then
                    Set r = Range(Cells(x, 1), Cells(x, 9))
                    r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.15
                End If
                x = x + 1
                y = 0
            Next Row

        Next body

        Range("B:D").EntireColumn.ColumnWidth = 45
        Range("E:i").EntireColumn.ColumnWidth = 2.5
    End With

End Sub

 

  • Obrigado 1
Link para o comentário
Compartilhar em outros sites
Murilo_Correa
 

Murilo_Correa

Postado
  • Autor
Postado
17 horas atrás, Basole disse:

Sim exatamente isso, puxa direto do site. O codigo copia o objeto tabela do site e com a função, que eu não conhecia, do selenium ToExcel cola os dados na aba.

 

Mas pena que os dados no site não são organizados como uma verdadeira tabela ou seja, fora de tabulação, isso atrapalha na hora fazer a programação, 

Mas eu ajustei o codigo abaixo, para percorrer todas as celulas da tabela do site e puxar os dados e inserir mais organizadamente possível e desconsiderando a primeira coluna que contem os numeros, pois contem celulas mescladas

 

* 1 - Esta tabela segue um padrão das demais consultas? 

* 2 - Insira ou ajuste os wait(s) no codigo, se necessario de acordo com o carregamento das paginas. 

* 3 -Se preferir da pra ajustar no codigo para o navegador chrome ficar com a tela invisivel.

Certo, entendi!

 

1 - Sim ele sempre vai permanecer neste padrão, alterando apenas os valores a direita da tabela.

2 - Ótimo, ajustados!

3 - Prefiro que permaneça visível pois assim caso haja algum erro com o site (que ocorre com certa frequência) é possível identificar.

 

Eu criei uma outra macro de formatação. Dentro desta planilha que utilizo coloquei uma cópia da tabela do site, depois que rodo o código que você me passou eu rodo a macro de formatação que deixa então tudo certinho conforme está no site, altera apenas espaçamento e cores, não está funcionando muito bem porém ajuda kkk.

 

Gostaria de pedir uma ultima ajuda, o código está puxando a partir da primeira linha, porém eu precisava que ele puxasse a partir do ID,

fica mais fácil para fazer a formatação depois pois preciso destas informações.

 

image.thumb.png.e6feb4e94638424e2d01b22b34088d95.png

Link para o comentário
Compartilhar em outros sites
  • Solução
Basole
 

Basole

Postado
  • Solução
Postado
agora, Murilo_Correa disse:

...Gostaria de pedir uma ultima ajuda, o código está puxando a partir da primeira linha, porém eu precisava que ele puxasse a partir do ID,

fica mais fácil para fazer a formatação depois pois preciso destas informações.

image.thumb.png.e6feb4e94638424e2d01b22b34088d95.png

 

@Murilo_Correa experimente agora com as alterações

 

Fiz uns remendos no que já havia feito, e agora ficou parecendo um frankenstein, mas deve fucinionar:

 

* Se puder post o print com o resultado da importação, para efito de ilustração aqui no topico: 

  

Sub Login_Suframa_Por_Celulas()
    ' Por bbasole882gmail.com
    Dim driver      As New ChromeDriver
    Dim r           As Range
    Dim Row         As Object
    Dim body        As Object
    Dim cell        As Object
    Dim x: x = 1
    Dim oTable      As Object
    Dim RowTh       As Object
    Dim cellTh      As Object
    Dim sThtd       As String: sThtd = "th"

    On Error GoTo trER:

    Excel.Application.ScreenUpdating = False

    With driver
         .Get "https://simnac.suframa.gov.br"
        .Wait (1000)
        .FindElementByName("usuario").SendKeys ("USUARIO")   ' * ALTERAR
        .FindElementByName("senha").SendKeys ("SENHA")       ' * ALTERAR
        .Wait (1000)
         .FindElementByXPath("/html/body/app-root/div/div/div/section/section/footer/button", 5).Click
         .Wait (5000)
        ' adiciona nova aba:
        With ThisWorkbook
            .Sheets.Add(Before:=Sheets(1)).Name = "Quadro Resumo_1"
        End With
        .Wait (1000)
        For Each oTable In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table")
            For Each RowTh In oTable.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr")
                For Each cellTh In RowTh.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/thead/tr[" & x & "]/" & sThtd & "")

                    y = y + 1
                    If VBA.InStr(1, cellTh.Text, "TOTAL") > 0 Then
                        y = 9: Cells(x, y) = VBA.Replace(cellTh.Text, VBA.Chr(10), " ")
                    Else
                        Cells(x, y) = VBA.Replace(cellTh.Text, VBA.Chr(10), " ")
                    End If
                Next
                ' efeito zebrado no intevalo de dados:
                If x Mod 2 <> 0 Then
                    Set r = Range(Cells(x, 1), Cells(x, 9)): r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.25    '15
                End If
                x = x + 1
                y = 0
                sThtd = "td"
            Next RowTh

        Next oTable
        x = 1: y = 0

        For Each body In .FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table")
            For Each Row In body.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr")
                For Each cell In Row.FindElementsByXPath("//*[@id='content']/section/section/section/section/app-consultar-quadro-pin/div/div/div/section/form/div/table/tbody/tr[" & x & "]/td")
                    y = y + 1
                    If VBA.InStr(1, cell.Text, "TOTAL DE PENDÊNCIAS POR DIAS PARA EXPIRAÇÃO DO PRAZO") > 0 Then
                        y = 4: Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " "): Cells(x + 2, y).Font.Bold = True    ' negrito
                    Else
                        If VBA.IsNumeric(cell.Text) And y = 1 Then
                            Cells(x + 2, y) = ""
                        ElseIf VBA.InStr(1, cell.Text, "Vistoria ") > 0 And y = 1 Then
                            y = 2
                            Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ")
                        Else
                            Cells(x + 2, y) = VBA.Replace(cell.Text, VBA.Chr(10), " ")
                        End If
                    End If
                Next cell
                ' efeito zebrado no intevalo de dados:
                If x Mod 2 <> 0 Then
                    Set r = Range(Cells(x + 2, 1), Cells(x + 2, 9)): r.Interior.ThemeColor = xlThemeColorDark1: r.Interior.TintAndShade = -0.15
                End If
                x = x + 1
                y = 0
            Next Row
        Next body

        Range("A:A").EntireColumn.ColumnWidth = 3.2: Range("B:D").EntireColumn.ColumnWidth = 45: Range("E:i").EntireColumn.ColumnWidth = 8.2
        Range("1:1").EntireRow.RowHeight = 26.75: Range(Cells(1, 1), Cells(1, 9)).Font.Size = 12: Range(Cells(1, 1), Cells(1, 9)).Font.Bold = True  ' negrito
        
        .Quit
    End With
trER:
    Excel.Application.ScreenUpdating = True

End Sub

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
Murilo_Correa
 

Murilo_Correa

Postado
  • Autor
Postado
21 horas atrás, Basole disse:

 

@Murilo_Correa experimente agora com as alterações

 

Fiz uns remendos no que já havia feito, e agora ficou parecendo um frankenstein, mas deve fucinionar:

 

* Se puder post o print com o resultado da importação, para efito de ilustração aqui no topico:

 

Perfeito!

image.thumb.png.5c3d32115428144524c99c94a6ae91e0.png

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
  • 7 meses depois...
  • 4 semanas depois...
  • 6 meses depois...

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora
 Compartilhar
Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!