VBAを使用してExcelファイルにパスワードを設定する

Question

特定のディレクトリにあるすべてのExcelファイルに対してパスワードを設定しようとしています。私は次のコードを試しましたが、残念ながらパスワードを設定していません。ファイルを開いたり閉じたりしているのを見ることができますが、ファイルを手動で開くとパスワードを要求しません。

Sub LoopThroughFiles() 
    Dim StrFolder As String 
    Dim StrFile As String 
    StrFolder = "S:\lnb\SecPFM\REPORTS\CRC\201608\" 
    StrFile = Dir(StrFolder & "*xls*") 
    Do While Len(StrFile) > 0 

     Workbooks.Open Filename:=StrFolder & StrFile, Password:="OpenFile" 
     Application.DisplayAlerts = False 
     ActiveWorkbook.Close Savechanges:=True 
     StrFile = Dir 
    Loop 
End Sub 

私はここで間違っていますか？これはExcel 2010の場合です

Answer 1

保存せずにファイルのパスワードを設定することはできません。

この場合、SaveAsが必要です。

Option Explicit 

Sub LoopThroughFiles() 
    Dim StrFolder As String 
    Dim StrFile As String 
    Dim wb As Workbook 

    StrFolder = "S:\lnb\SecPFM\REPORTS\CRC\201608\" 
    StrFile = Dir(StrFolder & "*xls*") 

    Do While Len(StrFile) > 0 

     Set wb = Workbooks.Open(Filename:=StrFolder & StrFile) 

     With wb 
      .SaveAs .Path & "\protected_" & .Name, xlExcel12, "OpenFile" 
     End With 

     Application.DisplayAlerts = False 
     ActiveWorkbook.Close Savechanges:=True 
     StrFile = Dir 
    Loop 
End Sub 

新しい保護されたバージョンを作成したくない場合は

あなたも、単に既存のファイルを上書きすることができます。

Application.DisplayAlerts = False 

    Do While Len(StrFile) > 0 

     Set wb = Workbooks.Open(Filename:=StrFolder & StrFile) 

     With wb 
      .SaveAs .FullName, , "OpenFile" 
     End With 

     ActiveWorkbook.Close Savechanges:=True 
     StrFile = Dir 
    Loop 

Application.DisplayAlerts = True 

を