プロが教える店舗&オフィスのセキュリティ対策術

質問タイトルの通りですが、詳しく書くと↓

<やりたいこと>
あるExcelファイル(Aとする)でマクロを有効にした時に、自動で、Aと同じフォルダにある複数のパスワード付ブックを読み取り専用で開く。

<条件?>
・同じフォルダに複数のパスワード付ブックがある。(ファイル名はバラバラ)
・パスワードはすべて共通。(Password=1111)


以下のようなコードを考え、ThisWorkbookに入れてみたのですが、思うような動作にならず・・・
--------------------------------------------------------------------------------------
Private Sub Workbook_Open()
Dim FileName As String
Dim OpenedBook As Workbook
Dim IsBookOpen As Boolean

FileName = Dir("*.xlsx")
Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then
IsBookOpen = False
For Each OpenedBook In Workbooks
If OpenedBook.Name = FileName Then '既にブックを開いていた時の処理
IsBookOpen = True
Exit For
End If
Next
If IsBookOpen = False Then
Workbooks.Open FileName, ReadOnly:=True, Password:="1111"
End If
End If
FileName = Dir()
Loop
End Sub
--------------------------------------------------------------------------------------
どこをどのように修正したらよいのか、教えて頂けると幸いです。

質問者からの補足コメント

  • コードの例をありがとうございます。
    実行結果は、同様でした。

    >思うような動作にならず・・・
    というのは、マクロを実行しても複数のパスワード付ブックのうち、なぜか1つしか開かないためです。
    PC環境の問題なのか、考えたコードでは、もともと無理なのか・・・?

    No.1の回答に寄せられた補足コメントです。 補足日時:2015/08/02 21:24

A 回答 (2件)

こんばんは。



特に、とりわけコード自体が間違っているとは思えません。
細かいことを言うなら、
If FileName <> ThisWorkbook.Name Then
とかは、一般的には、全体のループに取り込んでよいような気がしますが。後は、IsBookOpenのフラグの位置かな。

だから、こんな風にも書けるとは思いますが。

'//
Private Sub Workbook_Open()
 Dim FileName As String
 Dim wb As Workbook
 Dim IsBookOpen As Boolean
 Dim myPath As String
 myPath = CurDir() & "\" 'または、ThisWorkbook.Path & "\"
 FileName = Dir(myPath & "*.xlsx")
 Do While FileName <> ""
  For Each wb In Workbooks
   If wb.Name = FileName Then
     IsBookOpen = True
     Exit For
   End If
  Next wb
   If IsBookOpen = False Then
      Workbooks.Open myPath & FileName, ReadOnly:=True, Password:="1111"
   End If
   IsBookOpen = False
   FileName = Dir()
 Loop
End Sub

'///

>思うような動作にならず・・・
どのような問題が発生するのですか?
もし、発生するなら、こことは別の問題ではないでしょうか。
この回答への補足あり
    • good
    • 1

>>思うような動作にならず・・・


>というのは、マクロを実行しても複数のパスワード付ブックのうち、なぜか1つしか開かないためです。

それは、マクロの問題ではないと思いますね。
試しに、開く所で、Debug.Print を取ってみればどうでしょうか。これで情報が得られるはずです。なお、Left(Err.Description,15)は、エラーメッセージが長いおそれがあるので、割愛するためです。

 If IsBookOpen = False Then
      On Error Resume Next
      Workbooks.Open myPath & FileName, ReadOnly:=True, Password:="1111"
      If Err() <> 0 Then Debug.Print Left(Err.Description, 15); FileName; Tab(1)
      On Error GoTo 0
   End If
    • good
    • 0
この回答へのお礼

示されたエラー表示コードを入れてみましたが、開いた時にエラー表示はありませんでした。
そこで、No.1で示された myPath = CurDir() & "\" の所を ThisWorkbook.Path & "\" に変更した所、うまく動作しました。

ちょっと意外でしたが、問題が解決したので、No.1の方をベストアンサーに選ばせていただきました。
丁寧に解説して下さりありがとうございました。

お礼日時:2015/08/03 09:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています