Abrir vários arquivos com a mesma senha Excel

Gráfico no Excel com comentários
Gráfico no Excel com comentários
22 de dezembro de 2013
Gráfico Excel de Linha Sólida e Pontilhada
Gráfico Excel de Linha Sólida e Pontilhada
25 de janeiro de 2014

Objetivo: Abrir arquivos disponibilizados com uma senha semelhante.

Desproteger vários documentos Excel

Esta solicitação foi enviada pelo leitor Rogério Ruela no seu comentário:

Bom dia Marcos,

A senha vem no arquivo. Toda vez que vou abrir o arquivo tenho que digitar a senha. Como são muitos todos os dias e o sistema da empresa não aceita importar arquivos com senha, preciso tirar a senha. Só que uma a uma está ficando complicado, ainda mais que o volume de arquivos vão aumentar muito este ano.

Neste intuito criei a seguinte planilha, aonde ao clicar no botão Abrir diversos arquivos com a mesma senha o sistema solicita a pasta aonde estão os arquivos:

Desproteger vários documentos Excel 3

Na tela seguinte é solicitada a senha utilizada nos arquivos:

Desproteger vários documentos Excel 4

Em seguida o sistema irá abrir todos os arquivos que estiverem na pasta selecionada:

Desproteger vários documentos Excel 2

Segue o código fonte utilizado:

Sub lsAbrirArquivos(ByVal Caminho As String, ByVal lSenha As String)
    Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
    Dim Linha As Long
    Dim lSeq As Long
    Dim lNovoNome As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(Caminho) Then
        MsgBox "A pasta '" & Caminho & "' não existe.", vbCritical, "Erro"
        Exit Sub
    End If

    lSeq = 1

    Set Pasta = FSO.GetFolder(Caminho)
    Set Arquivos = Pasta.Files

    For Each Arquivo In Arquivos
        Workbooks.Open Filename:=UCase$(Arquivo.Path), Password:=lSenha, WriteResPassword:=lSenha
    Next
End Sub

'Seleciona os arquivos
Public Sub lsSelecionaArquivo()
    Dim Caminho As String
    Dim lSenha As String

    Caminho = InputBox("Informe o local dos arquivos", "Pasta", "c:\")
    lSenha = InputBox("Informe a senha dos arquivos:", "Senha", "")

    'Chama a função para renomear os arquivos
    lsAbrirArquivos Caminho, lSenha
End Sub

Abraço
Marcos Rieper


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/
Cursos

Curso Excel Completo – Curso Excel Básico + Curso Excel Avançado – Acesso Vitalício

R$218,00 R$179,00

COMPRAR
Cursos

Curso Excel Master – Curso Excel Básico + Curso Excel Avançado + Curso VBA Excel + LP – Acesso Vitalício

R$357,00 R$249,00

COMPRAR
Cursos

Curso Excel PRO – Curso Excel Avançado + Curso VBA Excel + Lógica de programação – Acesso Vitalício

R$258,00 R$199,00

COMPRAR
Cursos

Curso Excel Web – Curso VBA Excel + Lógica de programação + Curso Web Scraping VBA- Acesso Vitalício

R$388,90 R$309,00

COMPRAR

6 Comentários

  1. Rogerio Ruela disse:

    Bom dia Marcos,

    A planilha tem ajudado bastante, mas gostaria de saber se tem como, depois de abertas, salvá-las sem senha?

  2. Rogerio Ruela disse:

    Bom dia Marcos,

    Não pode ser incluído no script que você postou acima? E se sim, como ficaria?

    • Marcos Rieper disse:

      Bom dia Rogério,

      Ficaria o código abaixo:

      Sub lsAbrirArquivos(ByVal Caminho As String, ByVal lSenha As String)
      Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
      Dim Linha As Long
      Dim lSeq As Long
      Dim lNovoNome As String

      Set FSO = CreateObject(“Scripting.FileSystemObject”)

      If Not FSO.FolderExists(Caminho) Then
      MsgBox “A pasta ‘” & Caminho & “‘ não existe.”, vbCritical, “Erro”
      Exit Sub
      End If

      lSeq = 1

      Set Pasta = FSO.GetFolder(Caminho)
      Set Arquivos = Pasta.Files

      For Each Arquivo In Arquivos
      Workbooks.Open Filename:=UCase$(Arquivo.Path), Password:=lSenha, WriteResPassword:=lSenha
      ActiveWorkbook.SaveAs Filename:=UCase$(Arquivo.Path), _
      FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      Next
      End Sub

      ‘Seleciona os arquivos
      Public Sub lsSelecionaArquivo()
      Dim Caminho As String
      Dim lSenha As String

      Caminho = InputBox(“Informe o local dos arquivos”, “Pasta”, “c:\”)
      lSenha = InputBox(“Informe a senha dos arquivos:”, “Senha”, “”)

      ‘Chama a função para renomear os arquivos
      lsAbrirArquivos Caminho, lSenha
      End Sub
      Sub Macro4()

      ‘ Macro4 Macro


      ActiveWorkbook.SaveAs Filename:=”C:\Users\Rieper\Desktop\Pasta1.xlsm”, _
      FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      End Sub

      Abraço

      Marcos Rieper

  3. Rogerio Ruela disse:

    Bom dia Marcos,

    Me desculpe a ignorância, mas quando acrescentei o código deu o seguinte erro:
    Erro de compilação
    era esperado: número de linha ou rótulo ou Instrução ou fim da instrução.

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.