Abrir vários arquivos com a mesma senha Excel

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