[[20170310090823]]　『エクセルファイルのパスワード設定有無の表示につ』（みかん）　ページの最後に飛ぶ

『エクセルファイルのパスワード設定有無の表示について』（みかん）

お世話になります。

以下のようなことができるか教えて頂きたく、よろしくお願いします。

フォルダの中にエクセルがたくさん入っています。

マクロで処理をするのですが、エクセルを開く時のパスワードがかかっていると
処理をする時にファイルが開けないので、処理前にパスワードがかかっているものは
パスワードの解除をするようにしようと思っています。

エクスプローラの画面でファイルの情報(ファイル名や更新日時、種類、サイズなど)の
詳細表示を設定する画面でパスワードがかかっているかどうかがわかる項目はあるでしょうか？

もしも上記のことが無理な場合、代替案のようなことも教えて頂けると助かります。

どうぞよろしくお願い致します。

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

こんにちは

Sub test1()

    Dim tBK As Workbook
    Dim fNm As String
    fNm = "C:\temp\test.xls"
    On Error Resume Next
    Set tBK = Workbooks.Open(fNm, , , , "test")
    If tBK Is Nothing Then
        MsgBox "開けません"
        Exit Sub
    End If
    On Error GoTo 0
    Debug.Print tBK.FullName
    tBK.Close False
End Sub

パスワード指定して開くと、パスワード無しでも開けますし、一致してたら開ける
と思いますので、こんな感じでいのでは？

（ウッシ） 2017/03/10(金) 09:30

 回答の前に。

 >処理前にパスワードがかかっているものは パスワードの解除をするようにしようと思っています。

 解除するためにはパスワードが必要ですが、各々のブックのパスワードはわかっているということでしょうか？
 であれば、このブックならこのパスワードを与えて開く、このブックなら、このパスワードで、・・・・

 とすればいいわけです。

 パスワードはわからないけど、無効にして開きたいということですか？
 それができるなら、パスワードの意味がなくなりますよね。そういうことはできません。

 ましてや、そのパスワードをマクロで取得して、それを与えて開くなんてことを考えておられるとしたら
 それって、犯罪の要素を含む話になりますね。

 世の中には、そういったソフトが氾濫していますので不可能ではないのでしょうし、xl2007以降であれば、
 その方法を堂々と説明しているサイトもちらほらありますけど。

 やるなら、くれぐれも自己責任で。

（β） 2017/03/10(金) 09:36

●ウッシさん

ご回答ありがとうございます。
これは今使っているマクロでファイルをオープンするところに
追加するイメージでしょうか？
(マクロ、あまり詳しくないので、すみません。)

できれば、今使っているマクロの修正はせずに
マクロに取り込む前のエクセルでパスワードを解除しておきたいと思っています。

よろしくお願い致します。

●βさん

ご回答ありがとうございます。

各ブックのパスワードはわかっているんです。

詳細を書いてなくて、申し訳ありません。
作業の流れは以下なんです。

1．メールで申請書が届く。

   →申請書がエクセルで、読み取りパスワードがかかっている場合があります。

2．パスワードがかかっている場合、別メールでパスワードが届く。

3．申請書をフォルダに保存。

   →読み取りパスワードがかかっている場合は
　 　パスワードを解除して、エクセルをフォルダに保存。

この手順で処理をしているのですが、3．でパスワードの解除を忘れて
フォルダに保存してしまう場合があり、この後で処理するマクロで
止まってしまう場合があるんです。

なので、エクスプローラ画面でパスワードのかかっているファイル
(パスワードの解除を忘れているファイル)がわかれば
処理前にパスワードを解除してマクロが止まらないようにできる、と思った次第です。

よろしくお願い致します。

（みかん） 2017/03/10(金) 09:59

こんにちは

デスクトップに新規メモ帳を作成して、

Dim n
Dim appEX, mBook
Dim passW

On Error Resume Next
passW = InputBox("パスワードを入力","パスワード入力ボックス")
If passW <> "" Then

    For Each n In WScript.Arguments
        w = Right(n, 4)
        If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then
            If appEX is Nothing Then
                Set appEX = CreateObject("Excel.Application")
            End If
            With appEX
                .WindowState = -4137 'xlMaximized
                .Visible = 0
                Set mBook = .Workbooks.Open(n, , , , passW)
                If Not mBook Is Nothing Then
                    mBook.Password = ""
                    mBook.Save
                    mBook.Close
                End If
            End With
        End If
    Next
End If
On Error GoTo 0

をコピペして保存し、そのメモのファイル名、多分「新しいテキストドキュメント.txt」
となっているのを、「パスワード解除.vbs」のように変更する。

そのアイコンの上に、対象フォルダの「申請書.xlsx」等のアイコンをドラッグ＆ドロップ
してみて下さい。

同じパスワードのExcelファイルなら複数選択してドラッグ＆ドロップしても出来るはずです。

取り敢えずテストファイルで試して下さい。

（ウッシ） 2017/03/10(金) 10:34

ウッシさん

ありがとうございました。

パスワード入力画面でパスワードを入力した後の
動きはどのようになるのでしょうか？

今、試してみたのですが、パスワードを入力した後
白い画面が一瞬現れて、消えてしまいます。

またパスワードを設定していないエクセルの場合は
パスワード入力の項目は何も入力しないでいいですか？

よろしくお願い致します。
（みかん） 2017/03/10(金) 11:03

こんにちは

パスワードを設定していないエクセルはパスワードを解除する必要ないですよね？

パスワード入力画面でパスワードを入力した後は、ドラッグ＆ドロップしたファイルを
そのパスワードで開いて、パスワードを削除して保存して閉じてます。

ドラッグ＆ドロップされない時をスキップするように変更しました。

パスワード解除.vbsの中身を差し替えて下さい。

Dim n
Dim appEX, mBook
Dim passW
If WScript.Arguments.Count = 0 then

   MsgBox "パスワード付きのExcelファイルをドラッグ＆ドロップして下さい"
Else 
   On Error Resume Next
   passW = InputBox("パスワードを入力","パスワード入力ボックス")
   If passW <> "" Then
       For Each n In WScript.Arguments
           w = Right(n, 4)
           If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then
               If appEX is Nothing Then
                   Set appEX = CreateObject("Excel.Application")
               End If
               With appEX
                   .WindowState = -4137 'xlMaximized
                   .Visible = 0
                   Set mBook = .Workbooks.Open(n, , , , passW)
                   If Not mBook Is Nothing Then
                       mBook.Password = ""
                       mBook.Save
                       mBook.Close
                   End If
               End With
           End If
       Next
   End If
   On Error GoTo 0
End IF

（ウッシ） 2017/03/10(金) 11:27

ウッシさん

ありがとうございます。
だんだんやりたいことに近づいて来ました！

パスワードが設定されていない場合は、
パスワードの入力画面を出さないようにすることはできますか？
(ドラッグ＆ドロップはするけど、パスワードの入力画面も表示されず
エクセルファイルの上書き保存もないイメージです。)

よろしくお願い致します。
（みかん） 2017/03/10(金) 11:49

こんにちは

(ドラッグ＆ドロップはするけど、パスワードの入力画面も表示されず

 エクセルファイルの上書き保存もないイメージです。)

と言う事は、1ファイルずつ処理するという事ですか？

複数ファイルをドラッグ＆ドロップする場合はパスワード有りのファイルを
処理する毎にパスワードの入力が必要になりますから。

（ウッシ） 2017/03/10(金) 12:22

ウッシさん

ありがとうございます。

1ファイルずつドラッグ＆ドロップするイメージでした。
(複数ファイルドラッグ＆ドロップした場合、どのファイルの

 パスワードが求められているのかがわからないような気がしたので。)

複数ファイルをドラッグ＆ドロップした場合、
パスワード入力画面で、どのファイルのパスワードを入力したら
良いのかわかるのでしたっけ？

わかるのでしたら、複数ファイルをドラッグ＆ドロップする方が
効率がいいので、そうしたいです！

毎日100ファイル以上のエクセルを開いて、パスワードがかかっていないか
確認してるので、何とかしたいんです。

申し訳ありませんが、よろしくお願い致します。

（みかん） 2017/03/10(金) 13:11

こんにちは

毎日100ファイル以上のうち何ファイルがパスワード付きで、
しかもそれぞれが違うパスワードなんでしょうか？

大変さがどの程度軽減されるか分かりませんが、

Dim n
Dim appEX, mBook
Dim passW
If WScript.Arguments.Count = 0 then

   MsgBox "パスワード付きのExcelファイルをドラッグ＆ドロップして下さい"
Else 
   On Error Resume Next

   For Each n In WScript.Arguments
       w = Right(n, 4)
       If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then
           Set appEX = CreateObject("Excel.Application")
           With appEX
               .WindowState = -4137 'xlMaximized
               .Visible = 0
               Set mBook = .Workbooks.Open(n, , , , "")

               Select Case Err.Number
               Case 1004
                   passW = InputBox("パスワードを入力", n)
                   If passW <> "" Then
                       Set mBook = .Workbooks.Open(n, , , , passW)
                       If mBook Is Nothing Then
                           MsgBox "パスワード相違"
                       Else
                           mBook.Password = ""
                           mBook.Save
                           mBook.Close
                           Set mBook = Nothing
                       End IF
                   End If
               Case Else
                   mBook.Saved = 1
                   mBook.Close
                   Set mBook = Nothing
               End Select
           End With
       End If
   Next
   If Not appEX is Nothing Then
       appEX.Quit
       Set appEX = Nothing
   End If
   On Error GoTo 0
End IF

パスワード入力ダイアログのタイトルにファイルのフルパス表示しています。

（ウッシ） 2017/03/10(金) 14:06

ウッシさん

ありがとうございます。

100ファイル以上ありますが、自分でパスワード解除していて
その中で解除するのを忘れたものなので、0～3件です。
そのために処理が止まるもももったいないので・・。

パスワードは送り元が決めてるので、いろいろなんです。
統一したい気持ちはあるのですが、なかなか進まずです。

作って頂いた処理をしてみたのですが、
パスワードをかけていないファイルにもパスワードを聞いてくるようなんです。

・エクセル1：パスワードあり
・エクセル2：パスワードあり
・エクセル3：パスワードなし
・エクセル4：パスワードなし

の場合、エクセル3にもパスワード入力画面が出て来るんです。
エクセル4には出て来なかったです。

何かわかるでしょうか？

こんなに作って頂いて、本当に申し訳ないですが、
どうぞよろしくお願い致します。

（みかん） 2017/03/10(金) 14:33

こんにちは

分からないです。

エクセル3は手作業で開くとパスワード無しで開くのですか？

（ウッシ） 2017/03/10(金) 14:56

ウッシさん

こんにちは。
本当にすみません、ありがとうございます。

エクセル3、エクスプローラから手で開くとパスワードなしで開くんです。

あとプログラムを使うと、
ファイルも更新されてるので(更新時間が変わる)
パスワードが設定されているときと同じ動きのようなんです。

よろしくお願い致します。

（みかん） 2017/03/10(金) 15:06

こんにちは

Dim n
Dim appEX, mBook
Dim passW
If WScript.Arguments.Count = 0 then

   MsgBox "Excelファイルをドラッグ＆ドロップして下さい"
Else 
   On Error Resume Next

   For Each n In WScript.Arguments
       w = Right(n, 4)
       If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then
           Set appEX = CreateObject("Excel.Application")
           With appEX
               .WindowState = -4137 'xlMaximized
               .Visible = 0
               Err.Clear
               Set mBook = .Workbooks.Open(n, , , , "")

               Select Case Err.Number
               Case 1004
                   passW = InputBox("パスワードを入力", n)
                   If passW <> "" Then
                       Set mBook = .Workbooks.Open(n, , , , passW)
                       If mBook Is Nothing Then
                           MsgBox "パスワード相違"
                           Set mBook = Nothing
                       Else
                           mBook.Password = ""
                           mBook.Save
                           mBook.Close
                           Set mBook = Nothing
                       End IF
                       passW = ""
                   End If
               Case Else
                   mBook.Saved = 1
                   mBook.Close
                   Set mBook = Nothing
               End Select
           End With
       End If
   Next
   If Not appEX is Nothing Then
       appEX.Quit
       Set appEX = Nothing
   End If
   On Error GoTo 0
End IF

としても変わらないでしょうか？

（ウッシ） 2017/03/10(金) 15:10

ウッシさん

こんにちは。
ありがとうございます！
思った通りになりました。

本当にありがとうございました。
感謝いたします。
（みかん） 2017/03/10(金) 15:37

こんにちは。

本当の申請書で処理をしてみました。
大量にありすぎて、処理が終わったのかどうかがわからないのですが、
処理が終わったら、メッセージを出すとかできるでしょうか？

すみませんが、よろしくお願い致します。
（みかん） 2017/03/10(金) 16:00

こんにちは

一番最後に

MsgBox "処理終了"

で。

（ウッシ） 2017/03/10(金) 16:02

ありがとうございます。

それと、大量ファイルを処理しているときに
急に他の作業とか入ったときに
処理を途中で止めることはできるでしょうか？

次々すみません。
よろしくお願い致します。
（みかん） 2017/03/10(金) 16:03

こんにちは

                       End IF
                       passW = ""
                   End If

の部分を、

とすれば、パスワード聞かれた時点で何も入力せずにOKするか、
キャンセルすれば処理終了出来ます。

（ウッシ） 2017/03/10(金) 16:12

ウッシさん

今日1日、付きっ切りで本当にありがとうございました。
思い通りになりました！
助かりました。

また何か困ったら、ここで質問すると思います。
今後ともどうぞよろしくお願い致します。
（みかん） 2017/03/10(金) 16:34

コメント返信：

[ 一覧(最新更新順) ]

[[20170310090823]] 『エクセルファイルのパスワード設定有無の表示につ』（みかん） ページの最後に飛ぶ

[[20170310090823]]　『エクセルファイルのパスワード設定有無の表示につ』（みかん）　ページの最後に飛ぶ