【ExcelVBA】タイムスタンプを変えずにパスワード設定を行う

Sub PWフォルダ設定()

    Range("E6") = ""
    Range("E8") = ""
    MsgBox ("対象フォルダを指定してください！")
    Call selectFolder
    If Range("E6") = "" Then MsgBox ("処理を中止します！"): Exit Sub
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject

    Dim fl As Folder
    Set fl = fso.getFOLDER(Range("E6") & "\") 'フォルダを取得

    Dim f As File
    Dim d As Date
    Dim PW As String
    Dim SetPW As String
    
    Call マクロ開始

    PW = Range("E16")
    SetPW = Range("E18")
    
    Dim shell As Object
    Dim fl2 As Object
    Dim f2 As Object

    For Each f In fl.Files 'フォルダ内のファイルを取得
        If Left(f.Type, 15) <> "Microsoft Excel" Then
            GoTo nextloop   'Excelファイル以外は処理しない
        End If
        d = f.DateLastModified '更新日時を取得
        'PWを変更して保存
        Workbooks.Open fileName:=f, Password:=PW, UpdateLinks:=0
        ActiveWorkbook.SaveAs fileName:=f, Password:=SetPW
        Workbooks(f.Name).Close Savechanges:=True
    
        Set shell = CreateObject("Shell.Application") 'インスタンス化
        Set fl2 = shell.Namespace(Range("E6") & "\") 'フォルダを取得
        Set f2 = fl2.ParseName(f.Name) 'フォルダ内のファイルを取得
        
        f2.ModifyDate = d '更新日時を書き換える（元に戻す）
nextloop:
        Set f2 = Nothing
        Set fl2 = Nothing
        Set shell = Nothing
    Next
    
    Set f = Nothing
    Set fl = Nothing
    Set fso = Nothing
    
    Call マクロ終了
    If Range("E18") <> "" Then
        MsgBox ("パスワードをすべて変更しました！")
    Else
        MsgBox ("パスワードをすべて解除しました！")
    End If
End Sub

Sub PW選択ファイルを設定()
    Dim sfileName As String
    Dim boolRes As Boolean
    Range("E6") = ""
    Range("E8") = ""
    
    With Application.FileDialog(msoFileDialogOpen) '複数選択可で表示
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls*"
        .Title = "ファイルを指定して下さい"
        .AllowMultiSelect = True
        boolRes = .Show
        If boolRes = False Then MsgBox "処理を中止します！": Exit Sub
        sfileName = .SelectedItems(1)
        '選択ファイルの結果表示
        Range("E8") = Dir(sfileName) '最初のファイル名
        Range("E6") = Left(sfileName, InStrRev(sfileName, "\")) 'フォルダ
        
        Dim fso As FileSystemObject
        Set fso = New FileSystemObject
        Dim fl As Folder
        Set fl = fso.getFOLDER(Range("E6"))  'フォルダを取得
        
        Dim f As File
        Dim d As Date
        Dim PW As String: PW = Range("E16")
        Dim SetPW As String: SetPW = Range("E18")
    
        Call マクロ開始
    
        Dim shell As Object
        Dim fl2 As Object
        Dim f2 As Object
        Dim i As Long
        For i = 1 To .SelectedItems.Count 'fl.Files  'フォルダ内のファイルを取得
            sfileName = .SelectedItems(i)
            If i > 1 Then Range("E8") = Dir(sfileName) 'ファイル名変更
            Set f = fso.GetFile(sfileName)
            If Left(f.Type, 15) <> "Microsoft Excel" Then
                GoTo nextloop   'Excelファイル以外は処理しない
            End If
            d = f.DateLastModified      '更新日時を取得
            'ファイルを開きパスワードを設定してファイルを保存して閉じる
            Workbooks.Open fileName:=f, Password:=PW, WriteResPassword:=PW, UpdateLinks:=0
            ActiveWorkbook.SaveAs fileName:=f, Password:=SetPW
            Workbooks(f.Name).Close Savechanges:=True
    
            Set shell = CreateObject("Shell.Application") 'インスタンス化
            Set fl2 = shell.Namespace(fl & "\") 'フォルダを取得
            Set f2 = fl2.ParseName(f.Name)      'フォルダ内のファイルを取得
            
            f2.ModifyDate = d           '更新日時を書き換える（元に戻す）
nextloop:
            Set f = Nothing
            Set f2 = Nothing
            Set fl2 = Nothing
            Set shell = Nothing
        Next
    End With
    Set fl = Nothing
    Set fso = Nothing
    
    Call マクロ終了
    
    If Range("E18") <> "" Then
        MsgBox ("パスワードをすべて変更しました！")
    Else
        MsgBox ("パスワードをすべて解除しました！")
    End If
End Sub

Sub selectFolder()
    Dim strWORK As String
    strWORK = getFOLD()  'フォルダー選択関数
    Range("E6").Formula = strWORK
End Sub

'フォルダー選択関数（ダイアログを表示）
Function getFOLD() As String
    Dim dlg As FileDialog

    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    ' キャンセルボタンクリック時
    If dlg.Show = False Then
        getFOLD = ""
        Exit Function
    End If
    ' フォルダーのフルパスを変数に格納
    getFOLD = dlg.SelectedItems(1)
End Function