批量不保护excel工作簿

我有超过100个Excel工作簿在同一个文件夹中都保护着相同的密码。 寻找批量取消保护这些工作簿的方法。

我发现一个潜在的解决scheme是一个VBS代码作为解决scheme来复制和保存工作簿，但我不知道如何将该代码应用于该文件夹中的所有文件。

Set objExcel = CreateObject("Excel.Application") ' objExcel.Visible = TRUE objExcel.DisplayAlerts = FALSE ' Path1="C:\Users\xxxx\Test\Amazing Pty Ltd PW.xls" Path2="C:\Users\xxxx\TestCopy\Amazing Pty Ltd PW no.xls" ' Set objWorkbook = objExcel.Workbooks.Open(Path1,,,," ") ' objWorkbook.Unprotect("password") objWorkbook.SaveAs Path2 ' objExcel.Quit 

谢谢你的帮助！！

Answer 1

这是一个经过testing的脚本，通过循环“Test”目录中的文件，将代码应用于每个文件。

 'Loop through files in a directory using Filesystemobject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Set as the directory containing your files objStartFolder = "C:\Users\xxxx\Test\" 'Set as save to directory objSaveToFolder = "C:\Users\xxxx\TestCopy\" Set objFolder = objFSO.GetFolder(objStartFolder) Set colFiles = objFolder.Files Set objExcel = CreateObject("Excel.Application") objExcel.Visible = TRUE objExcel.DisplayAlerts = FALSE For Each objFile in colFiles 'Open the file with it full path name Set objWorkbook = objExcel.Workbooks.Open(objFSO.GetAbsolutePathName(objFile),false,false) objWorkbook.Unprotect("password") objWorkbook.SaveAs objSaveToFolder & objFile.name Next objExcel.Quit