vbs Do文がうまく機能しない？

質問

下記のコードを書いたのですが、うまく機能しません。
やりたいことは、ある読取りパスワードが設定されているエクセルファイルに、いくつかのパスワードを自動で適用して、パスワードが一致した時にエクセルファイルを開くということです。
実際にエクセルファイルに「password1」と設定して実行するとうまく開くのですが、「password2」を設定した場合、エクセルファイルは開かずに終わってしまいます。
私としては、Do文が絡んだときにPASSという変数にpassword2の文字列がうまく代入されていないのではないかと思っていますが、原因がわかりません。
何かご指摘を頂けると助かります。
======================================================
Dim xlApp, PASS
Dim x
On Error Resume Next
x = 1
Do until x = 10
Set xlApp=CreateObject("Excel.Application")

If x = 1 Then PASS = "password1"
If x = 2 Then PASS = "password2"

xlApp.Workbooks.Open "D:\pass\test.xls", 0, False, 5, PASS
If Err.Number = 0 Then
xlApp.Visible = True
Exit Sub
End If
xlApp.Workbooks.Close
Set xlApp = Nothing
x = x + 1
Loop
On Error Goto 0
Set xlApp = Nothing
======================================================
よろしくお願いします。

回答No.1

onlyrom · ベストアンサー

原因はエラー処理、というよりエラーの後始末がされてないからでは？

で、下記の●のところに、Err.Clearをいれてやる。

======================================================
Dim xlApp, PASS
Dim x
On Error Resume Next
x = 1
Do until x = 10
Set xlApp=CreateObject("Excel.Application")

If x = 1 Then PASS = "password1"
If x = 2 Then PASS = "password2"

xlApp.Workbooks.Open "D:\pass\test.xls", 0, False, 5, PASS
If Err.Number = 0 Then
xlApp.Visible = True
Exit Sub
End If

　●　Err.Clear

xlApp.Workbooks.Close
Set xlApp = Nothing
x = x + 1
Loop
On Error Goto 0
Set xlApp = Nothing
======================================================

外しましたらご容赦！

お礼

ご回答ありがとうございます。（返信が遅くなりましてすいません）
onlyromさんの仰る通り、エラーの後処理がされていないのでが原因でした。
今回は「Loop」の行の前に「On Error Goto 0」を移動したら回避できました。
ありがとうございました。

回答No.2

Wendy02

こんにちは。

今、たまたま見て、気になったけれども、そのコードは、パスワードの総当たり制の内容ですね。

>Set xlApp=CreateObject("Excel.Application")

まず、オートメーション・オブジェクトは、ループの外に出してね。

>Exit Sub

また、Sub プロシージャを作ってなければ、Exit Sub は利用できません。
仮に、通常はEnd で終了はしますが、If ～ End If が完結していないので、エラーが発生するはずです。

その場合は　Exit Do

PASSES = Array("password1","password2")
必要なだけ入れてください。なお、読み取りパスワードが設置されていたら、そちらも聞かれるはずです。

xlApp.Workbooks.Open fn, 0, False, 5, PASS, WriteResPassword

'------------------------------------

Dim xlApp, PASS, flg
Const FN ="D:\pass\test.xls"
Dim x
Dim PASSES
PASSES = Array("password1","password2")
flg =False
On Error Resume Next
x = 0
Set xlApp = CreateObject("Excel.Application")
Do Until x = UBound(PASSES)
PASS = PASSES(x)
xlApp.Workbooks.Open fn, 0, False, 5, PASS
If Err.Number = 0 Then
xlApp.Visible = True
flg = True
Exit Do
End If
Err.Clear
' xlApp.Workbooks.Close
x = x + 1
Loop
On Error GoTo 0
Set xlApp = Nothing
If flg =False Then
MsgBox "The File could not be opened with listed PassWords"
End if

'------------------------------------

お礼

ご回答ありがとうございます。（返信が遅くなってすいません）
>　今、たまたま見て、気になったけれども、そのコードは、パスワードの総当たり制の内容ですね。
そうです。パスワードがいっぱい有りすぎて、忘れてしまった時のためにスクリプトを書こうかと思いまして。。。

ちなみに、10桁のすべて英数字の文字列のパスワード総当りのスクリプトを実行してみたら、CPUは食うは、処理時間が膨大だわで、諦めました。。。

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