[[20200828163457]]　『マクロでフォルダ内全てのワードの読み取りパスワ』（もずく）　ページの最後に飛ぶ

『マクロでフォルダ内全てのワードの読み取りパスワードを解除する』（もずく）

お世話になります。もずくです。
フォルダ内の全てのExcelファイル、Wordファイルの読み取りパスワード一括解除のマクロを作っています。
Excelの方は上手く出来たのですが、Wordの方が検索に苦戦し上手く出来ません。
（.xlsxが変更されたのは確認できました。.xlsも対象にしたいです）

変更対象のフォルダのパスはB2のセルを参照するようにしています。

1、Wordの方、作ってみましたがDoからが違うようで動きません。

 .docxと.docを両方変更したいです。
Public Sub UnprotectFile()
    '--- Wordのアプリケーションオブジェクト ---'
    Dim objWord As Word.Application
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True

    myPath = Range("B2") & "\"
    myWord = Dir(myPath & "\*.docx*")

  Do While buf <> ""
  Set TargetDoc = Documents.Open(Filename:=myWord, PasswordDocument:="1234")
  With TargetDoc
    .Saved = False
    .SaveAs2 Filename:=(FilePath & buf), Password:=""
    .Close
  End With
  buf = Dir()
  Loop
End Sub

2、Excelの方、.xlsも一緒に変更したいです。もし.xlsファイルが無い場合はスルーして続行処理して欲しいです。
下記、私の作ったマクロに追加して修正が可能なら教えて頂きたいです。

Sub Macro1()

    Dim myPath As String, myExcel As String

    myPath = Range("B2") & "\"
    myExcel = Dir(myPath & "\*.xlsx*")

  Do Until myExcel = ""
  'On Error Resume Next
    Workbooks.Open Filename:=myPath & "\" & myExcel, Password:="1234"
    'パスワード解除
    ActiveWorkbook.Password = ""
    '保存して閉じる
    Workbooks(myExcel).Close SaveChanges:=True
    myExcel = Dir
  Loop

  MsgBox "終了しました"

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

動かしてみてはいませんが、"\*.docx*" ではなく、"\*.doc*" とすればすべて解決…、したりしませんかね？

あと、myWord はファイル名だけなので、myPath もくっつけましょう。 Excelの方は、ちゃんとしているようですが。
（???） 2020/08/28(金) 17:51

あれ、Excelの方は、\ が2つ重なってますね。まぁ、それでも正常動作するとは思いますけど、無駄ですね。
（???） 2020/08/28(金) 18:17

ここも、Excel版にならって

  ↓
  Do While myWord <> ""

（マナ） 2020/08/30(日) 10:44

出来ました！
ありがとうございます。
Excelに合わせるよう、Doの後更新したんですが、何やらエラーになったのでこのままにしました。

Sub Macro1()

    Dim myPath As String, myExcel As String
    Application.ScreenUpdating = False

    myPath = Range("B2")
    myExcel = Dir(myPath & "\*.xls*")

    Do Until myExcel <> ""
        Workbooks.Open Filename:=myPath & "\" & myExcel, Password:="1234"
        'パスワード解除
        ActiveWorkbook.Password = ""
        '保存して閉じる
        Workbooks(myExcel).Close SaveChanges:=True
        myExcel = Dir
    Loop

    Application.ScreenUpdating = True

    Call UnprotectFile

    MsgBox "終了しました"

End Sub

Sub UnprotectFile()

    '--- Wordのアプリケーションオブジェクト ---'
    Dim objWord As Word.Application
    Application.ScreenUpdating = False
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True

    myPath = Range("B2")
    myWord = Dir(myPath & "\*.doc*")

    Do While myWord <> ""
        Set TargetDoc = Documents.Open(Filename:=myPath & "\" & myWord, PasswordDocument:="1234")
        With TargetDoc
            .Saved = False
            .SaveAs2 Filename:=myPath & "\" & myWord, Password:=""
            .Close
        End With
        myWord = Dir()
    Loop

    objWord.Visible = False
    Application.ScreenUpdating = True

End Sub
（もずく） 2020/09/01(火) 16:45

これって何をしているのでしょうか

 > .Saved = False

 > objWord.Visible = False

（マナ） 2020/09/01(火) 18:32

With TargetDoc

            .Saved = False
            .SaveAs2 Filename:=myPath & "\" & myWord, Password:=""
            .Close

これはこちらのサイトからコピペしたのでちょっと意味が分からないんです。
ここのパスワード変更して閉じるはかなり苦戦しました。
https://amacoda.net/blog/2017/08/unprotect_files_for_excel_word_powerpoint_automatically/

objWord.Visible = False

これは「ワードファイルを開くコード」で検索して見つけました。
最初にTrueでWordアプリを開いてるので、最後にFalseで閉じました。
これをしないと更新したWordを保存じて閉じた後もアプリだけ開きっぱなしになるのかと。。
（もずく） 2020/09/02(水) 09:14

＞.Saved = False

不要かと思ったのですが、試してみたら、必要でした。
Excelと違って、開いて、ただ閉じるだけでは、
Saveを実行しても更新されないようです。

＞objWord.Visible = False

非表示にしているだけなので終了していません。
リンク先と同じように

objWord.Quit

としてください。

（マナ） 2020/09/02(水) 18:51

マナさん、ありがとうございます。
すいません。追加で問題が出たので教えて頂いて宜しいでしょうか？

Excelのパスワード解除ですが、下記警告メッセージが表示されました。
'○○○.xls'は現在の形式では保存できません。変更を保存するには、［OK］をクリックし、最新の形式で保存して下さい。
更新する場合、拡張子を変更して下さい。分かったらOKボタン押してねと言ってるんですね。。

なので、もし（If）このエラーが出たファイルは下記操作を自動で行いたいです。
1、「OK」ボタンを自動で押す
2、拡張子を変更して同じ名前で保存する
　⇒調べたらこんな感じかと
　　【xlsxへの変更方法】ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "名前",FileFormat:=xlworkbookdefault
3、昔の.xlsは消す。消すの難しそうなのでB5セルから順にエラーの出たファイル名を出力して手動で消していこうかと思います。

難しいようなら、拡張子変更しろメッセージが出た場合、B5セルから順にエラーの出たファイル名を出力して、次のファイルに取り掛かって貰う（スキップ）にしたいです。エラーファイルは手動で変更します。

可能でしょうか？
（もずく） 2020/09/03(木) 10:12

Wordと同じように、SaveAsメソッドを使って、
全ファイルを最初から xlsx形式で保存してはどうですか。]

（マナ） 2020/09/03(木) 19:22

コメント返信：

[ 一覧(最新更新順) ]

[[20200828163457]] 『マクロでフォルダ内全てのワードの読み取りパスワ』（もずく） ページの最後に飛ぶ

[[20200828163457]]　『マクロでフォルダ内全てのワードの読み取りパスワ』（もずく）　ページの最後に飛ぶ