エクセルの学校：全文検索：Hyper Estraier： VBA 強制終了

Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)

vba (14710), 強制終了 (237)

[[20180725130156]]: #score: 16177; @digest: 6b1bc480ab2b9487d0df47cf60ffe5ca; @id: 76906; @mdate: 2018-07-25T11:02:39Z; @size: 8725; @type: text/plain; #keywords: ーー (111074), 行). (46173), fileopen (37389), 勤事 (30483), 暇区 (27628), 分ra (22075), 名ra (19402), 事由 (18102), ス& (17877), 請日 (16078), 日ra (15272), スワ (14023), 名<> (11153), パス (9700), ド= (8579), 名, (7722), 名= (7320), ルパ (6857), 分= (6780), 休暇 (6325), 申請 (5062), ル名 (4602), ファ (4469), 続行 (4372), ワー (4189), ス= (4078), password (3639), 行= (3608), ァイ (3460), 所属 (3373), 区分 (3305), myfile (3268); 『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 ＞ ---- Sub macro1() 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 だとおもいますが・・・）以下、気づきの点で。「パスワードが間違っていたら、繰り返し入力して、合っていたら処理を続行」とのことですから、少なくとも、違うパスワードを入れてブックが開けないというエラーが発生したら、再度パスワードを入力させるという処理に移行しないとダメですよね。さらに言えば、上記の処理に移行したらしたで、正しいパスワードを入れるまでずっと聞いてくるわけですから、「あきらめる」って選択肢がないですよね。これだと困ると思うので、キャンセルボタン押したたら、聞くのをやめて次の処理に行くなり、プログラムを終了させるなどにしないと使い勝手がわるいとおもいます。なので、とりあえず全体の部分は置いておいて↑の部分だけ実験で作ってみては如何でしょうか。 #当然ですが、フォルダパスやファイル名は適時自分の環境に合わせて変えて下さい。 #このままですと、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 と、ここまで書いてパスワードを自動入力って言ってるから、いくつかの候補から総当たりで試して、合うものがあればブックを開くってことでしょうか? そうであれば、ループで処理する必要かあると思います。（もこな2） 2018/07/25(水) 20:02 ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/201807/20180725130156.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ