[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAでフォルダの中にあるExcelファイルの保護パスワードを、自動入力した後のエラー処理』（たいやき）
こんにちは。
VBAを勉強してから一週間が経ちました。
フォルダの中にある複数のExcelファイルを、キーワード検索で開きたいファイルを抽出して、ブックの保護パスワードを自動入力する。もし、パスワードが間違っていたら、繰り返し入力して、合っていたら処理を続行するというVBAを作成しております。
しかし、1004のエラーで「パスワードが間違っています」とエラー表示され、VBAが終了してしまいます。どうすればパスワードが合うまでループし、パスワードが合っていたら処理を続行することができるのか、ご教授いただきたく投稿させていただきました。
よろしくお願いします。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub macro1()
Application.ScreenUpdating = False
ファイルパス = ThisWorkbook.Path & "\"
ファイル名 = Dir(ファイルパス & "*キーワード*")
行 = Range("A65536").End(xlUp).Row + 1
Do While ファイル名 <> ""
Workbooks.Open Filename:=ファイルパス & ファイル名, Password:="パスワード"
(セルを指定し一覧にする処理)
Loop
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
Application.ScreenUpdating = False
ファイルパス = ThisWorkbook.Path & "\"
ファイル名 = Dir(ファイルパス & "*キーワード*")
行 = Range("A65536").End(xlUp).Row + 1
Do While ファイル名 <> ""
pw = "パスワード"
Do While fileopen(ファイルパス & ファイル名, pw) = False
pw = InputBox(ファイルパス & ファイル名, "パスワード入力")
Loop
' (セルを指定し一覧にする処理)
ファイル名 = Dir()
Loop
End Sub
Function fileopen(arg1, arg2) As Boolean
Dim wb As Workbook
On Error GoTo ere
Set wb = Workbooks.Open(Filename:=arg1, Password:=arg2)
fileopen = True
wb.Close False
ere:
End Function
（mm） 2018/07/25(水) 14:04
まだ、エラーが直せない状況ではありますが、再度行き詰まったら、また質問させていただきたいと思います。
（たいやき） 2018/07/25(水) 14:46
コードを自分なりに調べて改良してみたのですが、どうしてもエラーが出て直せないです。。
何度も厚かましいですが、ご教授お願い致します。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub macro1()
Application.ScreenUpdating = False
ファイルパス = ThisWorkbook.Path & "\"
ファイル名 = Dir(ファイルパス & "*休暇届*")
行 = Range("A65536").End(xlUp).Row + 1
Do While ファイル名 <> ""
pw = "1234"
Do While fileopen(ファイルパス & ファイル名, pw) = False
pw = InputBox(ファイルパス & ファイル名, "パスワード入力")
Loop
区分 = Range("B1").Value
申請日 = Range("D10").Value
所属 = Range("D13").Value
氏名 = Range("J13").Value
期間始 = Range("E18").Value
期間終 = Range("E23").Value
日数 = Range("L21").Value
休暇区分 = Range("D26").Value
休暇出勤事由 = Range("D28").Value
備考 = Range("D31").Value
ActiveWindow.Close
Range("A" & 行).Value = 区分
Range("B" & 行).Value = 申請日
Range("C" & 行).Value = 所属
Range("D" & 行).Value = 氏名
Range("E" & 行).Value = 期間始
Range("F" & 行).Value = 期間終
Range("G" & 行).Value = 日数
Range("H" & 行).Value = 休暇区分
Range("I" & 行).Value = 休暇出勤事由
Range("J" & 行).Value = 備考
Range("K" & 行).Value = "-"
Range("L" & 行).Value = "-"
Range("M" & 行).Value = ファイル名
Range("N" & 行).Value = FileDateTime(ThisWorkbook.Path & "\" & ファイル名)
行 = 行 + 1
ファイル名 = Dir()
Loop
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub macro2()
ファイルパス = ThisWorkbook.Path & "\"
ファイル名 = Dir(ファイルパス & "*休日出勤届*")
行 = Range("A65536").End(xlUp).Row + 1
Do While ファイル名 <> ""
pw = "1234"
Do While fileopen(ファイルパス & ファイル名, pw) = False
pw = InputBox(ファイルパス & ファイル名, "パスワード入力")
Loop
区分 = Range("A1").Value
申請日 = Range("C10").Value
所属 = Range("C13").Value
氏名 = Range("I13").Value
期間自 = Range("D18").Value
期間至 = Range("D23").Value
日数 = Range("K21").Value
休暇区分 = Range("C48")
出勤事由 = Range("C26")
備考 = Range("C31").Value
処理方法 = Range("E39").Value
代休予定日 = Range("I39").Value
ActiveWindow.Close
Range("A" & 行).Value = 区分
Range("B" & 行).Value = 申請日
Range("C" & 行).Value = 所属
Range("D" & 行).Value = 氏名
Range("E" & 行).Value = 期間自
Range("F" & 行).Value = 期間至
Range("G" & 行).Value = 日数
Range("H" & 行).Value = 休暇区分
Range("I" & 行).Value = 出勤事由
Range("J" & 行).Value = 備考
Range("K" & 行).Value = 処理方法
Range("L" & 行).Value = 代休予定日
Range("M" & 行).Value = ファイル名
Range("N" & 行).Value = FileDateTime(ThisWorkbook.Path & "\" & ファイル名)
行 = 行 + 1
ファイル名 = Dir()
Loop
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Function fileopen(arg1, arg2) As Boolean
Dim wb As Workbook
On Error GoTo ere
Set wb = Workbooks.Open(Filename:=arg1, Password:=arg2)
fileopen = True
wb.Close False
ere:
End Function
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub クリア()
Range("A3").CurrentRegion.Offset(2, 0).ClearContents
End Sub
Sub 更新日時の追加()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim f As File
Set f = fso.GetFile("D:\Tips.txt")
Dim d As Date
d = f.DateLastModified
Range("N1").Value = d
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub TOTAL()
Call macro1
Call macro2
MsgBox "書き出しが完了しました"
Application.ScreenUpdating = True
End Sub
（たいやき） 2018/07/25(水) 18:05
以下、気づきの点で。
「パスワードが間違っていたら、繰り返し入力して、合っていたら処理を続行」とのことですから、
少なくとも、違うパスワードを入れてブックが開けないというエラーが発生したら、再度パスワードを入力させるという処理に移行しないとダメですよね。
さらに言えば、上記の処理に移行したらしたで、正しいパスワードを入れるまでずっと聞いてくるわけですから、「あきらめる」って選択肢がないですよね。
これだと困ると思うので、キャンセルボタン押したたら、聞くのをやめて次の処理に行くなり、プログラムを終了させるなどにしないと使い勝手がわるいとおもいます。
なので、とりあえず全体の部分は置いておいて↑の部分だけ実験で作ってみては如何でしょうか。
#当然ですが、フォルダパスやファイル名は適時自分の環境に合わせて変えて下さい。
#このままですと、1004以外のエラーが発生しても、同じエラー処理をしてしまいます。
#本来は、エラーナンバーでの分岐などをしたほうがよいのでしょうけど長くなるので割愛します
Sub 実験1()
Const MyPath As String = "D:\Work\"
Dim パスワード As String
Dim MyFile As String
MyFile = Dir(MyPath & "*実験*")
パスワード = Application.InputBox(Prompt:=MyFile & "のパスワードを入力してください", Title:=MyFile & "がみつかりました")
If パスワード = "False" Then
MsgBox "キャンセルが押されたためプログラムを強制終了します"
Exit Sub
End If
On Error GoTo エラー処理
Workbooks.Open Filename:=MyPath & MyFile, Password:=パスワード
Exit Sub
エラー処理:
Err.Clear
パスワード = Application.InputBox( _
Prompt:=MyFile & "のパスワードを入力してください" & vbCrLf & "あきらめる場合はキャンセルをクリック", _
Title:="パスワードが違うようです")
If パスワード = "False" Then
MsgBox "キャンセルが押されたためプログラムを強制終了します"
Exit Sub
End If
Resume
End Sub
と、ここまで書いてパスワードを自動入力って言ってるから、いくつかの候補から総当たりで試して、合うものがあればブックを開くってことでしょうか?
そうであれば、ループで処理する必要かあると思います。
（もこな２） 2018/07/25(水) 20:02
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.