[已解决]如何给excle 文件加密

a8426048 · 发表于 2013-10-30 08:57

利用VBA 给一个文件夹下的所有excle 文件加密成 “linglu”

最佳答案

月排行榜 / 总排行榜

suye1010

2013-10-30 10:51

本帖最后由 suye1010 于 2013-10-31 13:14 编辑

Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell,objFolder,FolderPath,PassWord,wk,EAPP,FSO,FSOFolder,FSOFile
'获取Excel文件所在文件夹路径
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS,"")
If objFolder Is Nothing Then
Wscript.Quit
End If
FolderPath =objFolder.Self.Path
PassWord=Inputbox("请输入密码","批量添加密码")
if len(password)=0 then Wscript.Quit
Set EAPP=CreateObject("Excel.Application")
Set FSO=CreateObject("Scripting.FileSystemObject")
Set FSOFolder=FSO.GetFolder(FolderPath)
For Each FSOFile in FSOFolder.Files
If instr(Fsofile.Name,".xls") then
Set wk=EAPP.Workbooks.Open(FSOFile)
wk.Password=PassWord
wk.Close True
End If
EAPP.Quit
Next

复制代码

复制到记事本并修改相应的内容,存储为.VBS文件,双击运行,即可.

AddPasswordToXls.zip (636 Bytes, 下载次数: 33)

zhp3 · 发表于 2013-10-30 10:48

要不用BatchXLS这个软件试试？

BatchXLS285.zip (862.07 KB, 下载次数: 11)

zhp3 · 发表于 2013-10-30 10:50

suye1010 · 发表于 2013-10-30 10:51

这个最佳答案由 suye1010 给出，感谢 suye1010 的回答。

单击隐藏图章

本帖最后由 suye1010 于 2013-10-31 13:14 编辑

Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell,objFolder,FolderPath,PassWord,wk,EAPP,FSO,FSOFolder,FSOFile
'获取Excel文件所在文件夹路径
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS,"")
If objFolder Is Nothing Then
Wscript.Quit
End If
FolderPath =objFolder.Self.Path
PassWord=Inputbox("请输入密码","批量添加密码")
if len(password)=0 then Wscript.Quit
Set EAPP=CreateObject("Excel.Application")
Set FSO=CreateObject("Scripting.FileSystemObject")
Set FSOFolder=FSO.GetFolder(FolderPath)
For Each FSOFile in FSOFolder.Files
If instr(Fsofile.Name,".xls") then
Set wk=EAPP.Workbooks.Open(FSOFile)
wk.Password=PassWord
wk.Close True
End If
EAPP.Quit
Next

复制代码

复制到记事本并修改相应的内容,存储为.VBS文件,双击运行,即可.

AddPasswordToXls.zip (636 Bytes, 下载次数: 33)

a8426048 · 发表于 2013-10-30 17:04

suye1010 您好！！

你这代码挺好的，就是太死，能不能弄成选择路径呀！！这样可以方便我选择任何一个文件夹下的文件，不用我每次都的把文件拷贝到一个路径下！！

清风明月12 · 发表于 2014-2-21 17:41

谢谢楼主的分享！很好用啊。

ww0000 · 发表于 2015-1-12 11:38

好用是好用,但不知道如何改成解密的脚本?

ww0000 · 发表于 2015-1-12 22:22

改成保护工作表密码，可是手动不能解除，不知是何原因？

Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell,objFolder,FolderPath,PassWord,wk,EAPP,FSO,FSOFolder,FSOFile,sht,mySheet,Worksheets,Sheets,Protect,Name
'获取Excel文件所在文件夹路径
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS,"")
If objFolder Is Nothing Then
Wscript.Quit
End If
FolderPath =objFolder.Self.Path
PassWord=Inputbox("请输入密码","批量添加密码")
if len(password)=0 then Wscript.Quit
Set EAPP=CreateObject("Excel.Application")
Set FSO=CreateObject("Scripting.FileSystemObject")
Set FSOFolder=FSO.GetFolder(FolderPath)
For Each FSOFile in FSOFolder.Files
If instr(Fsofile.Name,".xls") then
Set wk=EAPP.Workbooks.Open(FSOFile)
For Each sht in wk.Worksheets
mySheet = sht.Name
wk.Sheets(mySheet).Protect PassWord=PassWord
Next
wk.Close True
End If
EAPP.Quit
Next

		自动登录	找回密码
密码			注册

[已解决]如何给excle 文件加密

相关帖子