Разблокируйте несколько рабочих книг, и каждая рабочая книга имеет собственный пароль (VBA) - PullRequest
Новая
       19

Разблокируйте несколько рабочих книг, и каждая рабочая книга имеет собственный пароль (VBA)

0 голосов
/ 04 октября 2018

Извините, ребята, у меня возник вопрос по поводу разблокировки нескольких защищенных книг

, так как у меня в папке было защищено более 200 книг xlsm, скажем, хранить в "C: \ temp"

У меня есть другая рабочая книга (так называемый password.xlsm), в которой хранится пароль этих 200 рабочих книг xlsm на рабочем листе 1, я хочу удалить все пароли всех файлов xlsm с помощью макроса.

, например 

file  password
A     112233
B     225588
C     KKK999
..    ...

и вот мой код, я нахожу некоторые скрипты VBA для справки, но я нуб 

Sub UnEncyptedFile()
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
Dim oWorkbook As Excel.Workbook
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim Pwcode As String

Dim filename As String
Dim LastRow As Long

Set objFSO = CreateObject("Scripting.FilesyStemObject")
Set objFolder = objFSO.GetFolder("C:\temp")

LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each objFile In objFolder.Files
    checkfilename = objFile.Name
    checkfilename = Left(checkfilename, Len(checkfilename) - 5)
       For i = 2 To LastRow
           If ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = checkfilename Then

           Pwcode = ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value    
           Set oWorkbook = oExcel.Workbooks.Open(objFolder & "\" & objFile.Name, Password:=Pwcode)
           oWorkbook.SaveAs Filename:=objFolder & "\" & objFile.Name, Password:=""
           oWorkbook.Close (True)

           End If
           Exit For
      Next i    
Next objFile
End Sub

, если я проверяю, что имя файла совпадает с именем, которое я храню в «пароле» этой книги влист1, столбец A, затем я открываю файл и сохраняю файл по его первоначальному пути и удаляю пароль: = ""

я успешно открыл книгу (A.xlsm), но он не назначил пароль автоматическипоэтому он только открывает рабочую книгу, но мне нужно ввести пароль вручную .... и тогда он перестает зацикливаться

Может кто-нибудь помочь мне, где проблема?

1 Ответ

0 голосов
/ 04 октября 2018

Вы можете попробовать это, хотя я изменил логику.Вместо того, чтобы перебирать папку, я перебираю файлы Excel, хранящиеся на вашем master excel (password.xlsm) в Column A.

Sub Robot()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Loc As String: Loc = "C:\tempt\"
Dim pw As String, fn As String, cb As Workbook, i As Long

'Loc = Local Location
'pw = Password
'fn = File Name
'cb = Current Book

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        On Error Resume Next 'If book does not exist
            fn = Loc & ws.Range("A" & i)
            pw = ws.Range("B" & i)

            Set cb = Workbooks.Open(fn, Password:= pw)

            cb.SaveAs fn, Password:=""
            cb.Close False 'You just saved the book above, no need for TRUE
        On Error GoTo 0
    Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
...