为给定文件夹中的多个工作簿分配密码

Posted 2023-05-07

【中文标题】为给定文件夹中的多个工作簿分配密码

【英文标题】：Assigning password to multiple workbooks in a given folder

【发布时间】：2017-02-12 08:27:54

【问题描述】：

让我告诉你这个问题。我们根据我可以将文件拆分到单独的工作簿中的报告来准备摘要报告。

主要问题是：

我尝试了多种方法来使用不同的密码保护多个工作簿。在我的 excel 密码文件中，根据 excel 列 A 名称需要在文件夹中分配密码列 B工作簿。每个月手动做真的很痛苦

是否有一种简单的方法可以保护多个工作簿，而无需打开每个工作簿并通过 VBA 代码分配密码？据我所知，我们可以为所有工作簿分配相同的密码，但根据需要根据我的 Excel 存储密码查找不同的密码

非常感谢您的帮助

【问题讨论】：

“我尝试了很多方法来保护多个不同密码的工作簿”：向我们展示其中一种方法

感谢您的回复......

Sub Passwordprotect() '打开密码保护文件 Application.DisplayAlerts = False Application.ScreenUpdating = False Application.Workbooks.Open "C:\Cb.xlsx", False ActiveWorkbook.SaveAs Filename:="C :\Cb.xlsx", Password:="basu" ActiveWorkbook.Close SaveChanges:=True End Sub 这里每天手动编写...这需要很长时间，甚至需要编写 500 个 excel 名称和路径

【参考方案1】：

一个可能的解决方案

Sub protectwpwd()
Dim i As Long, wb As Workbook, ws As Worksheet
    i = 1
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
    While ws.Cells(i, 1) <> ""
        Workbooks.Open ws.Cells(i, 1)
        ActiveWorkbook.Saveas ws.cells(i,1),Password:=ws.Cells(i, 2)
        ActiveWorkbook.Close
        i = i + 1
    Wend
End Sub

【讨论】：

嗨，感谢您的代码出现错误，因为如何编写代码以在代码中搜索我的文件夹以分配密码

通过循环......是的，我们可以......需要修改，因为它应该查看我可以提供的文件夹，然后它应该开始分配提到的 A 列 excel 名称和 B 列密码保持循环到最后请帮助我

请修改文件夹目录的循环方式

Subprotectwpwd() Dim i As Long, wb As Workbook, ws As Worksheet Dim directory As String, fileName As String Application.ScreenUpdating = False directory = "c:\VBA\" fileName = Dir( directory & ".xlsx") i = 1 Set wb = ThisWorkbook Set ws = wb.ActiveSheet While ws.Cells(i, 1) "" Workbooks.Open ws.Cells(i, 1) ActiveWorkbook.SaveAs ws.Cells (i, 1), 密码:=ws.Cells(i, 2) ActiveWorkbook.Close i = i + 1 Wend End Sub

创建的循环仍然无法正常工作...运行时错误 - “1004”抱歉，我们找不到 details.xlsx，它可能被移动或删除了吗？在这里我检查了两次我可以找到 excel xlsx 名称...如何修复