Excel VBA質問箱 IV

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

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


187 / 13190 ツリー ←次へ | 前へ→

【79281】フォルダ内パスワード一括設定について VBA 17/6/30(金) 14:23 質問[未読]
【79283】Re:フォルダ内パスワード一括設定について マナ 17/6/30(金) 22:26 発言[未読]
【79284】Re:フォルダ内パスワード一括設定について マナ 17/6/30(金) 23:05 発言[未読]

【79281】フォルダ内パスワード一括設定について
質問  VBA  - 17/6/30(金) 14:23 -

引用なし
パスワード
   初めまして、VBA勉強中の者です。

【前提】
フォルダ内にある多数のファイルについてまとめて1つのパスワードを設定したいと考えています。
なお、フォルダ内にパスワードが設定されているファイルとされていないファイルが混在しているため、一旦全てパスワードを解除した後、まとめてパスワードを設定する必要があります。
各所を参考に、2つコードを入力したのですが、以下2点についてご教示いただければ幸いです。
(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

【79283】Re:フォルダ内パスワード一括設定について
発言  マナ  - 17/6/30(金) 22:26 -

引用なし
パスワード
   ▼VBA さん:

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

ここを参考に考えてみてはどうでしょうか。
ht tp://www.moug.net/tech/exvba/0060088.html


(1)については、問題なさそうですが試してみてから。

【79284】Re:フォルダ内パスワード一括設定について
発言  マナ  - 17/6/30(金) 23:05 -

引用なし
パスワード
   ▼VBA さん:

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

ごめんなさい。
試しましたが、こちらでは、エラーになりませんのでお役に立てません。

-----

エラーと関係ないのですが、

>    '文末に改行を挿入し削除(何らかの変更がないと上書き保存できない)

これについては、無駄に編集しなくても

ActiveDocument.Saved = False

を追加すれば、保存できます。
試してみてください。

あとWith〜end withを使用して、
こんな感じにすると、コードもすっきりします。

With Documents.Open(FileName:=p & myfn, PasswordDocument:=pwopen)
  .Saved = False
  .Password = pwclose
  .Close True
End With

187 / 13190 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free