使用不同的密码对文件夹中的多个Excel文件进​​行密码保护

时间:2019-07-11 08:41:57

标签: excel vba

我有一个文件,其中包含不同供应商声明的所有密码的列表。根据供应商名称的不同,所有密码都不同,但包含相同的数字部分,然后每月更改一次。例如。第一个月可以使用诸如SupplierA655456和SupplierB655456之类的密码,然后在下个月可以使用SupplierA789987和SupplierB789987之类的密码。

所有语句都保存在同一个文件夹中,我只是想知道是否可以创建代码对这些文件进行密码保护?

谢谢

我创建了使用相同密码保存所有文件的代码,但是它们必须不同。

Sub ProtectAll()
    Dim xWorkBooks As Workbook
    Dim xExitFile As String
    Dim xPassWord As Variant
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error Resume Next
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then
        Exit Sub
    Else
        xStrPath = xStrPath + "\"
    End If
    xPassWord = Application.InputBox("Enter password", "Kutools for Excel", , , , , , 2)
    If (xPassWord = False) Or (xPassWord = "") Then
        MsgBox "Password cannot be blank!", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
<span style="background-color: #ffff00;">    xFile = "*.xls"</span>
    xExitFile = Dir(xStrPath & xFile)
    On Error Resume Next
    Application.ScreenUpdating = False
    Do While xExitFile <> ""
        Set xWorkBooks = Workbooks.Open(xStrPath & xExitFile)
        Application.DisplayAlerts = False
        xWorkBooks.SaveAs Filename:=xWorkBooks.FullName, Password:=xPassWord
        Application.DisplayAlerts = True
        Workbooks(xExitFile).Close False
        Set xWorkBooks = Nothing
        xExitFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Successfully protect!", vbInformation, "Kutools for Excel"
End Sub

此代码可以很好地保护所有文件,但是我可以用它来区分密码吗?

0 个答案:

没有答案