各位网友，大家好。

今天给大家介绍如何用vba批量给excel工作簿设置添加打开密码。

今天的内容主要分为以下三个部分：

手动设置添加打开密码；

在vba中用工作簿Workbook对象的SaveAs方法设置添加打开密码；

在vba中用工作簿Workbook对象的Password属性的方式设置添加打开密码。

一、手动设置添加打开密码

在excel中，如果想要给某个工作簿添加打开密码，可以在“另存为”对话框中的“工具”按钮内的“常规选项”中进行设置，如下图所示：

二、在vba中用工作簿Workbook对象的SaveAs方法设置添加打开密码

在vba中可以直接使用Workbook对象的SaveAs方法在将某个工作簿另存为时，设置添加打开密码。

它的语法如下：

expression.SaveAs (FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)

其中参数Password表示打开密码。

以下是一个将当前excel工作簿另存为具有打开密码”abc”的vba代码：

Visual Basic

Sub QQ1722187970()

Dim oWB As Workbook

Set oWB = Excel.ThisWorkbook

oWB.SaveAs "d:\test.xlsm", xlOpenXMLWorkbookMacroEnabled, "abc"

End Sub

1

2

3

4

5

SubQQ1722187970()

DimoWBAsWorkbook

SetoWB=Excel.ThisWorkbook

oWB.SaveAs"d:\test.xlsm",xlOpenXMLWorkbookMacroEnabled,"abc"

EndSub

执行上述代码后保存关闭，重新打开excel工作簿会弹出输入打开密码的提示，如下图所示：

三、在vba中用工作簿Workbook对象的Password属性的方式设置添加打开密码

除了可以用Workbook对象的SaveAs方法在将某个工作簿另存为时，设置添加打开密码外，还可以通过直接设置Workbook对象的Password属性值的方式给excel工作簿设置打开密码。

以下是为当前excel工作簿设置打开密码”abc”的vba代码：

Visual Basic

Sub QQ1722187970()

Dim oWB As Workbook

Set oWB = Excel.ThisWorkbook

oWB.Password = "abc"

End Sub

1

2

3

4

5

SubQQ1722187970()

DimoWBAsWorkbook

SetoWB=Excel.ThisWorkbook

oWB.Password="abc"

EndSub

用这种方法设置打开密码，不仅可以为尚未设置打开密码的excel工作簿添加打开密码，还可以修改已经有打开密码的excel工作簿的密码为其它密码。

四、批量给同一文件夹下的所有Excel工作簿添加打开密码

如果要批量给同一文件夹下的所有Excel工作簿添加打开密码，可以使用如下的代码：

Visual Basic

Sub QQ1722187970()

Excel.Application.Calculation = xlCalculationManual

Excel.Application.DisplayAlerts = False

Dim oWB As Workbook

Dim sPath As String

sPath = GetPath

Dim sResult As String

'查找第一个文件,第一次使用dir函数

sResult = Dir(sPath & "\*.xls*")

If Len(sResult) Then

Set oWB = Excel.Workbooks.Open(sPath & "\" & sResult)

oWB.SaveAs sPath & "\" & sResult, , "test"

oWB.Close

Debug.Print sResult

Do

'重复使用dir函数，此时不用输入任何参数

sResult = Dir

Debug.Print sResult

If Len(sResult) Then

Set oWB = Excel.Workbooks.Open(sPath & "\" & sResult)

oWB.SaveAs sPath & "\" & sResult, , "test"

oWB.Close

End If

'直到返回的字符串为空字符串，表示遍历结束

Loop Until Len(sResult) = 0

End If

Excel.Application.DisplayAlerts = True

Excel.Application.Calculation = xlCalculationAutomatic

End Sub

Function GetPath() As String

'声明一个FileDialog对象变量

Dim oFD As FileDialog

' '创建一个选择文件对话框

' Set oFD = Application.FileDialog(msoFileDialogFilePicker)

'创建一个选择文件夹对话框

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)

'声明一个变量用来存储选择的文件名或者文件夹名称

Dim vrtSelectedItem As Variant

With oFD

'允许选择多个文件

.AllowMultiSelect = True

'使用Show方法显示对话框，如果单击了确定按钮则返回-1。

If .Show = -1 Then

'遍历所有选择的文件

For Each vrtSelectedItem In .SelectedItems

'获取所有选择的文件的完整路径,用于各种操作

GetPath = vrtSelectedItem

Next

'如果单击了取消按钮则返回0

Else

End If

End With

'释放对象变量

Set oFD = Nothing

End Function

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

SubQQ1722187970()

Excel.Application.Calculation=xlCalculationManual

Excel.Application.DisplayAlerts=False

DimoWBAsWorkbook

DimsPathAsString

sPath=GetPath

DimsResultAsString

'查找第一个文件,第一次使用dir函数

sResult=Dir(sPath&"\*.xls*")

IfLen(sResult)Then

SetoWB=Excel.Workbooks.Open(sPath&"\" & sResult)

oWB.SaveAs sPath & "\"&sResult,,"test"

oWB.Close

Debug.PrintsResult

Do

'重复使用dir函数，此时不用输入任何参数

sResult=Dir

Debug.PrintsResult

IfLen(sResult)Then

SetoWB=Excel.Workbooks.Open(sPath&"\" & sResult)

oWB.SaveAs sPath & "\"&sResult,,"test"

oWB.Close

EndIf

'直到返回的字符串为空字符串，表示遍历结束

LoopUntilLen(sResult)=0

EndIf

Excel.Application.DisplayAlerts=True

Excel.Application.Calculation=xlCalculationAutomatic

EndSub

FunctionGetPath()AsString

'声明一个FileDialog对象变量

DimoFDAsFileDialog

'    '创建一个选择文件对话框

'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)

'创建一个选择文件夹对话框

SetoFD=Application.FileDialog(msoFileDialogFolderPicker)

'声明一个变量用来存储选择的文件名或者文件夹名称

DimvrtSelectedItemAsVariant

WithoFD

'允许选择多个文件

.AllowMultiSelect=True

'使用Show方法显示对话框，如果单击了确定按钮则返回-1。

If.Show=-1Then

'遍历所有选择的文件

ForEachvrtSelectedItemIn.SelectedItems

'获取所有选择的文件的完整路径,用于各种操作

GetPath=vrtSelectedItem

Next

'如果单击了取消按钮则返回0

Else

EndIf

EndWith

'释放对象变量

SetoFD=Nothing

EndFunction