Objetivo: Abrir arquivos disponibilizados com uma senha semelhante.
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:
Na tela seguinte é solicitada a senha utilizada nos arquivos:
Em seguida o sistema irá abrir todos os arquivos que estiverem na pasta selecionada:
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