プロが教える店舗&オフィスのセキュリティ対策術

エクセルのVBAで同じフォルダーにある全てのエクセルファイルに開封パスワード、全てのシートの関数入力セルに保護パスワードを設定したいのですが、対象をエクセルファイルに限定することが出来ずに悩んでおります。現状ではパワーポイントのファイルなどがあるとVBAの実行中にエラーとなってしまいます。
対象をエクセルに限定する方法をご教授くださいますようお願いいたします。

環境:windows10、Excel2016
   対象とするエクセルファイルの形式はxls と xlsx が混在


現状のVBA(ネットで見つけたコードを切り貼りして作成しました。)
Sub Excel_Protect()

Dim MyPath As String
Dim MyWb As Workbook
Dim MyWbName As String
Dim acFileObj As Object
Dim acFileObjName As String

Set MyWb = ThisWorkbook
MyPath = MyWb.Path
MyWbName = MyWb.Name

Dim sh As Worksheet
Dim openPass As String
openPass = Range("B1").Value ・・・既存ファイルのパスワード
Dim myPass As String
myPass = Range("B2").Value  …新たに設定するパスワード

Dim FileSysObj As Object
Dim FileObj As Object
Set FileSysObj = CreateObject("Scripting.FileSystemObject")
Set FileObj = FileSysObj.GetFolder(MyPath).Files


Application.ScreenUpdating = False

For Each acFileObj In FileObj
acFileObjName = acFileObj.Name
If InStr(acFileObjName, MyWbName) Then
Else
Workbooks.Open MyPath & "\" & acFileObjName, Password:=openPass

For Each sh In Worksheets

sh.Unprotect Password:=openPass
sh.Cells.Locked = False
On Error GoTo ErrLabel
sh.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
sh.Protect Password:=myPass

ErrLabel:
Resume Next

Next sh
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs MyPath & "\" & acFileObjName, Password:=myPass
ActiveWorkbook.Close False

End If
Next acFileObj

Application.DisplayAlerts = True
MsgBox "終了しました"

End Sub

A 回答 (1件)

ではこんなのは如何でしょう?


--------------------------------------------------------------------------------
Sub Sample()
Dim strRes As Variant
Dim strPath As String
Dim intO As Integer
Dim objBok As Workbook

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
strPath = .SelectedItems(1)
End If
End With
strRes = Dir(strPath & "\*.xlsx")

Do While strRes <> ""
gintO = gintO + 1
Set objBok = Workbooks.Open(strPath & "\" & strRes)
For intl = 1 To objBok.Sheets.Count
Debug.Print objBok.Sheets(intl).Name
Next intl
objBok.Close SaveChanges:=True
strRes = Dir()
Loop
End Sub

--------------------------------------------------------------------------------
簡素化していますが、パスが固定でしたら最初のWithブロックは不要ですので直接strPathに設定してください
Do内がブック数、For内がシート数でループしていますのでDebug.Printの部分で保護操作してもらえれば良いと思います

如何でしょうか?
    • good
    • 0
この回答へのお礼

rukaandkaito 様
ご教授いただきありがとうございます。
しかしながら、私の力量ではご提示いただいた内容を即活用することが出来ませんでした。少し時間をかけて試行してみます。
ご親切にしていただき感謝申し上げます。

お礼日時:2019/07/03 09:50

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!