Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

159 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79281】フォルダ内パスワード一括設定について

ＶＢＡ - 17/6/30(金) 14:23 -


	引用なし

	パスワード

初めまして、ＶＢＡ勉強中の者です。

【前提】
フォルダ内にある多数のファイルについてまとめて１つのパスワードを設定したいと考えています。
なお、フォルダ内にパスワードが設定されているファイルとされていないファイルが混在しているため、一旦全てパスワードを解除した後、まとめてパスワードを設定する必要があります。
各所を参考に、２つコードを入力したのですが、以下２点についてご教示いただければ幸いです。
（Excel2010を使用しています。）

【質問内容】
(1)下記コードのうち、Excel版は問題なく動作するのですが、Word版を実行したところ「実行時エラー'424":オブジェクトが必要です」と出てしまいます。修正方法をご教示いただけないでしょうか。（エラー箇所は★の部分）

(2)今回のマクロでは当該フォルダのみを動作の対象としていますが、下層フォルダもまとめて一括で動作するように設定はできないものでしょうか。

【入力コード（※設定したいパスワードが「aaa」の場合】
1.Excel版
Sub パスワードExcel()
　　Dim myfolder, myfn, myword, pwopen, pwclose
　　Dim pattern
　　'操作を選択
　　pattern = MsgBox("パスワード解除ならば「はい」、セットならば「いいえ」", vbYesNo)
　　If pattern = vbCancel Then
　　　　Exit Sub
　　End If
　　'パスワードをセット
　　myword = "aaa"
　　If pattern = vbYes Then
　　　　pwopen = myword
　　　　pwclose = ""
　　ElseIf pattern = vbNo Then
　　　　pwopen = ""
　　　　pwclose = myword
　　End If
　　'フォルダを選択
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "操作したいファイルのあるフォルダを選択"
　　　　.AllowMultiSelect = False
　　　　If .Show = -1 Then
　　　　　　myfolder = .SelectedItems(1)
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End With
　　'ファイルを操作
　　myfn = Dir(myfolder & "\*.xls*", vbNormal)
　　Do Until myfn = ""
　　　　Call ファイル開閉(myfolder & "\" & myfn, pwopen, pwclose)
　　　　myfn = Dir
　　Loop
End Sub
Function ファイル開閉(myfn, pwopen, pwclose)
　　Workbooks.Open Filename:=myfn, passWord:=pwopen
　　Application.DisplayAlerts = False
　　ActiveWorkbook.SaveAs Filename:=myfn, passWord:=pwclose, WriteResPassword:=""
　　Application.DisplayAlerts = True
　　ActiveWorkbook.Close
End Function

2.Word版
Sub パスワードWord()
　　'フォルダ内の共通のパスワードがセットされた文書を連続して開き、解除して上書き保存。
　　'逆にフォルダ内の文書を連続して開き、共通のパスワードをセットして上書き保存。
　　Dim onoff As Long
　　Dim mypw, pwopen, pwclose, mypath, myfn As String
　　'操作を選択
　　onoff = MsgBox("パスワード解除ならば「はい」、セットならば「いいえ」", vbYesNo)
　　If onoff = vbCancel Then
　　　　Exit Sub
　　End If
　　'パスワードをセット
　　mypw = "aaa"
　　If onoff = vbYes Then
　　　　pwopen = mypw
　　　　pwclose = ""
　　ElseIf onoff = vbNo Then
　　　　pwopen = ""
　　　　pwclose = mypw
　　Else
　　　　Exit Sub
　　End If
　　'フォルダの選択
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "フォルダを選択"
　　　　.AllowMultiSelect = False
　　　　If .Show = -1 Then
　　　　　　mypath = .SelectedItems(1) & "\"
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End With
　　'ファイルの取得と実行
　　myfn = Dir(mypath & "*.doc*", vbNormal)
　　Do Until myfn = ""
　　　　'開
　　　　★Documents.Open FileName:=mypath & myfn, PasswordDocument:=pwopen★
　　　　'文末に改行を挿入し削除(何らかの変更がないと上書き保存できない)
　　　　Selection.EndKey Unit:=wdStory
　　　　Selection.TypeParagraph
　　　　Selection.MoveLeft Unit:=wdCharacter, Count:=1
　　　　Selection.Delete Unit:=wdCharacter, Count:=1
　　　　'上書き保存
　　　　ActiveDocument.SaveAs Filename:=ActiveDocument.FullName, passWord:=pwclose, WritePassword:=""
　　　　ActiveWindow.Close
　　　　myfn = Dir
　　Loop
End Sub