Access2003でデータを指定してフォームを開く時のVBAを教えてください。

質問

Access2003で社員の情報管理用データベースを作成中です。

社員の入力済み基礎情報を参照するメインフォームと、新たに詳細情報を入力するためのサブフォームから成る"データ入力"フォームを作成し、メインとサブは"社員番号"でリンクさせました。

このフォームを開く時に、InputBoxに社員番号（アルファベットと数字が混ざった７文字）を入力して該当社員を呼び出すよう、以下のようにイベントプロシージャを記述したのですが、
社員番号を入れずに（あるいは存在しない社員番号や桁数を入力して）[OK]をクリックしたとき、もしくは[キャンセル]をクリックしたときにも白紙のフォームが開いてしまいます。

Private Sub Form_Open(Cancel As Integer)

Dim stName As String

stName = InputBox("社員番号を入力してください。", "社員番号入力", "半角英数７ケタで入力してください。")

DoCmd.ApplyFilter, "社員番号='" & stName & "'"

End Sub

これを以下のような設定にしたいです。

1.[キャンセル]をクリックしたときにはフォームを開く動作がキャンセルされる
2.空欄、あるいはデータ上に存在しない社員番号を入力した状態で[OK]を押したときにはフォームを開かず、正しい社員番号の入力を促す警告メッセージが表示される

記述の仕方を教えていただきたいです。
どうぞよろしくお願いいたします。

回答No.4

30246kiku · ベストアンサー

InputBox では、「キャンセル」＝空欄になったと思います。
なので、空欄時は Cancel するものとします。

以下記述でどうなりますか。
（警告メッセージは出しませんが、社員番号の入力になります）

Private Sub Form_Open(Cancel As Integer)
　　Dim stName As String

　　Do
　　　　stName = InputBox("社員番号を入力してください。", _
　　　　　　　　　　"社員番号入力", "半角英数７ケタで入力してください。")

　　　　If (Len(stName) = 0) Then
　　　　　　Cancel = True
　　　　　　Exit Do
　　　　End If

　　　　DoCmd.ApplyFilter , "社員番号='" & stName & "'"
　　　　If (Me.Recordset.RecordCount > 0) Then Exit Do
　　Loop
End Sub

補足）

このフォームを DoCmd.OpenForm で起動していたら、Cancel = True とすると、
その DoCmd.OpenForm 部分はエラー扱いされたと思います。
On Error Resume Next や On Error GoTo XXXX の記述が必要になると思います。

回答No.7

30246kiku

＃６です

私は　教えて! goo の方から回答させてもらってます。
＃６の投稿メールが届いていないのに、お礼、補足のメールが先に届くというのも・・・
また、お礼が後から届いたので、解決されたのかな、と思ってました。
OKWaveの方で、お礼、補足の投稿日時を見たところ、補足の方が後だったのですね。
確認が遅れて申し訳ありません。

キャンセルはどうしても判別したい、
という補足があった場合用の回答も準備していたので、それも合わせて。
（MsgBox 部分は追加してみました）

・キャンセルを押した
・変更せずにOK押した
・初期表示を消しただけでOK押した

この操作を「継続したくない為」、と（同じに）考えれば、
キャンセルを判別する必要はないような気がします。

Private Sub Form_Open(Cancel As Integer)
　　Dim stName As String
　　Const sDefMsg = "半角英数７ケタで入力してください。"

　　Do
　　　　stName = InputBox("社員番号を入力してください。", _
　　　　　　　　　　"社員番号入力", sDefMsg)

　　　　If ((Len(stName) = 0) Or (stName = sDefMsg)) Then
　　　　　　Cancel = True
　　　　　　Exit Do
　　　　End If

　　　　Me.Filter = "社員番号='" & stName & "'"
　　　　Me.FilterOn = True
　　　　If (Me.Recordset.RecordCount > 0) Then Exit Do
　　　　MsgBox("入力が間違っています。")
　　Loop
End Sub

で良いと思います。

次を入力　については、

Private Sub 次を入力_Click()
　　If MsgBox("続けて別な社員のデータを入力しますか？", vbYesNo) = vbYes Then
　　　　DoCmd.Close acForm, Me.Name
　　　　On Error Resume Next
　　　　DoCmd.OpenForm "データ入力"
　　End if
End Sub

で、エラーを無視すれば良さそうです。
（但し、Cancel = True を返すとフォームは消えちゃっていますが）

別案）Form_Open に記述した処理を流用します。
（ただし、現在表示している内容を変えないようにしないと・・・を注意します）

Private Sub 次を入力_Click()
　　Dim stName As String
　　Const sDefMsg = "半角英数７ケタで入力してください。"

　　If MsgBox("続けて別な社員のデータを入力しますか？", vbYesNo) = vbYes Then
　　　　Do
　　　　　　stName = InputBox("社員番号を入力してください。", _
　　　　　　　　　　　　"社員番号入力", sDefMsg)

　　　　　　If ((Len(stName) = 0) Or (stName = sDefMsg)) Then
　　　　　　　　Exit Do
　　　　　　End If

　　　　　　stName = "社員番号='" & stName & "'"
　　　　　　If (IsNull(DLookup("社員番号", "テーブル名", stName))) Then
　　　　　　　　MsgBox("入力が間違っています。")
　　　　　　Else
　　　　　　　　Me.Filter = stName
　　　　　　　　Me.FilterOn = True
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop
　　End If
End Sub

※　DLookup の "テーブル名" 部分は、正しいものに置き換えてください。
※ このフォームのレコードソースと同じものですよね？

蛇足）Form_Open で Cancel = True を返す場合がある時の一例

このフォームを呼ぶ側ですが、順序立てて考え、構成していきます。

　　DoCmd.OpenForm "データ入力"

Form_Open のパラメータを Cancel = True で戻ると、上記部分はエラー扱いされます。
エラー番号は 2501 になることを確認できます。

エラーの処理記述を追加していきます。
エラー番号が 2501 なら、また呼び出す。

　　On Error GoTo ERR_HAND
　　DoCmd.OpenForm "データ入力"

ERR_HAND:
　　If (Err.Number = 2501) Then Resume

これで、Cancel = True を返さなくなるまで、フォーム「データ入力」を呼び続けます。

無限にするのも嫌だと思うので、３回まで繰り返しましょうか、というようにするには、

　　Dim iCount As Integer

　　On Error GoTo ERR_HAND
　　iCount = 0
　　DoCmd.OpenForm "データ入力"

ERR_EXIT:
　　Exit Sub

ERR_HAND:
　　iCount = iCount + 1
　　if (iCount >= 3) Then Resume ERR_EXIT
　　If (Err.Number = 2501) Then Resume

ここに、自フォームを閉じるのであれば、どこに記述すればよいのか考えます。
OpenForm 前ですると、自フォーム、データ入力とも消えてしまう場合があるので、

　　On Error GoTo ERR_HAND
　　iCount = 0
　　DoCmd.OpenForm "データ入力"
　　DoCmd.Close acForm, Me.Name

DoCmd.Close では、誰を閉じるのか、を指定しておいた方が良いような気がします。

今回は、自分を閉じて自分を開いて・・・なので考えないといけないと思いますが。

お礼

回答ありがとうございます。無事できました。
一番めのシンプルな記述で行くことにしました。

前回は補足＆お礼でわかりにくくてこちらこそすみません…。
私もgooからの利用ですが、投稿メール、平気で２日くらい遅れて届いてきますよね・・・。

とにもかくにも、何回もご親切にありがとうございました！

回答No.6

30246kiku

＃４です

DoCmd.ApplyFilter , "社員番号='" & stName & "'"

だと連続でできないみたいなので、

Me.Filter = "社員番号='" & stName & "'"
Me.FilterOn = True

にしてみてください。

お礼

ありがとうございました！　無事できました。
ちなみに、最後のLoopの前に以下のようにメッセージボックスの記述を入れて、メッセージボックスも表示できました。
MsgBox("入力が間違っています。")

補足

ちなみに、この"データ入力"フォームを開いた後のことなのですが、
何人かのデータを続けて入力したい場合に、フォームに作ったコマンドボタン[次を入力]をクリックして、社員番号を入力し、新たな社員を呼び出す、
というかたちにしたく、コマンドボタンのクリック時のプロシージャを以下のように記述しました。

Private Sub 次を入力_Click()

If MsgBox("続けて別な社員のデータを入力しますか？", vbYesNo) = vbYes Then
DoCmd.Close
DoCmd.OpenForm "データ入力"
Else
End if

Exit_次を入力_Click:
Exit Sub

Err_次を入力_Click：
MsgBox Err.Description
Resume Exit_次を入力_Click

End Sub

つまり、見かけは連続入力（？）なのですが、実は単純に、いったん閉じてまた開く、という構造にしています。
（この方法以上に複雑なVBAは書けなかったので…。）
しかしこの場合、再度開いたインプットボックスで、[OK]の処理は初回同様に問題ないのですが、
[キャンセル]をクリックするとエラーが出てしまいます。
エラーメッセージは「実行時noOpenFormアクションの実行はキャンセルされました」で、
デバックを押すと、4行目の「DoCmd.OpenFrom "データ入力"」の記述のところがマーカーされていて問題みたいなのですが、
どのように修正したらよいかわかりません・・・。

厚かましいお願いですが、もしおわかりになりましたら追加で教えていただけると助かります。
よろしくお願いします。

回答No.5

piroin654

コード中の説明をいれておきます。
なお、
DoCmd.ApplyFilter , "社員番号=" & lnNumber
DoCmd.ApplyFilter , "社員番号='" & lnNumber & "'"
の部分はプログラム中でエラーの出ないほうを
選択してください。試していないので。バリアントで
定義しているのでどちらでもと思いますが。

Private Sub Form_Open(Cancel As Integer)
Dim lnNumber As Variant

lnNumber = InputBox("社員番号を入力してください。", "社員番号入力", "半角英数７ケタで入力してください。

")
'キャンセルを押した場合
If StrPtr(lnNumber) = 0 Then
MsgBox ("キャンセルですね。")
Cancel = True
'未入力でOKを押した場合
ElseIf Len(lnNumber) = 0 Then
MsgBox ("社員番号を入力してください。")
Cancel = True
Else
'数値を入力した場合
If IsNumeric(lnNumber) Then
'テーブルにない社員番号を入力した場合
If funcSearchNumber(lnNumber) = False Then
MsgBox ("この社員番号は存在しません。")
Cancel = True
'正しい社員番号が入力された場合
Else
'以下はいづれかで。
Cancel = False
' DoCmd.ApplyFilter , "社員番号=" & lnNumber
' DoCmd.ApplyFilter , "社員番号='" & lnNumber & "'"
End If
'数値でないものが入力された場合
Else
MsgBox ("社員番号は半角英数７ケタで入力してください。")
Cancel = True
End If
End If
End Sub

Private Function funcSearchNumber(myNumber As Variant) As Boolean
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T社員", dbOpenDynaset)

rs.FindFirst "社員番号=" & myNumber
If rs.NoMatch Then
funcSearchNumber = False
Else
funcSearchNumber = True
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function

お礼

やってみましたが、なぜかエラーになってしまい開けませんでした・・・。
デバックを押すと、
最後のほうの
rs.FindFirst "社員ID="　& myNumber
にマーカーがされていたのですが、よくわからず・・・
今回は＃４さんの記述でやってみることにしました。

でも、ご回答ありがとうございました。

回答No.3

piroin654

関数の後処理を抜かしていたので訂正をします。

Private Function funcSearchNumber(myNumber As Variant) As Boolean
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T社員", dbOpenDynaset)

rs.FindFirst "社員番号=" & myNumber
If rs.NoMatch Then
funcSearchNumber = False
Else
funcSearchNumber = True
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function

回答No.2

piroin654

メッセージがみな同じではどうもという
感じなので変更しました。以下文章が
同じものがくっついていますが。

社員番号があるテーブルをT社員とします。
InputBoxに入力する社員番号は、
>Dim stName As String
だとすると文字型になってしまうし、
InputBoxに文字列が最初から入っている
ことなどを考慮して、以下のように
します。社員番号が存在するかどうかの
判定に関数を追加しています。
なお、社員テーブルをT社員としています。
必要に応じて変更してください。

Private Sub Form_Open(Cancel As Integer)
Dim lnNumber As Variant

lnNumber = InputBox("社員番号を入力してください。", "社員番号入力", "半角英数７ケタで入力してください。

")
If StrPtr(lnNumber) = 0 Then
MsgBox ("キャンセルですね。")
Cancel = True
ElseIf Len(lnNumber) = 0 Then
MsgBox ("社員番号を入力してください。")
Cancel = True
Else
If IsNumeric(lnNumber) Then
If funcSearchNumber(lnNumber) = False Then
MsgBox ("この社員番号は存在しません。")
Cancel = True
Else
Cancel = False
End If
Else
MsgBox ("社員番号は半角英数７ケタで入力してください。")
Cancel = True
End If
End If
End Sub

Private Function funcSearchNumber(myNumber As Variant) As Boolean
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T社員", dbOpenDynaset)

rs.FindFirst "社員番号=" & myNumber
If rs.NoMatch Then
funcSearchNumber = False
Else
funcSearchNumber = True
End If
End Function

回答No.1

piroin654

社員番号があるテーブルをT社員とします。
InputBoxに入力する社員番号は、
>Dim stName As String
だとすると文字型になってしまうし、
InputBoxに文字列が最初から入っている
ことなどを考慮して、以下のように
します。社員番号が存在するかどうかの
判定に関数を追加しています。
なお、社員テーブルをT社員としています。
必要に応じて変更してください。

Private Sub Form_Open(Cancel As Integer)
Dim lnNumber As Variant

lnNumber = InputBox("社員番号を入力してください。", "社員番号入力", "半角英数７ケタで入力してください。

")
If StrPtr(lnNumber) = 0 Then
MsgBox ("社員番号を入力してください。")
Cancel = True
ElseIf Len(lnNumber) = 0 Then
MsgBox ("社員番号を入力してください。")
Cancel = True
Else
If IsNumeric(lnNumber) Then
If funcSearchNumber(lnNumber) = False Then
MsgBox ("社員番号を入力してください。")
Cancel = True
Else
Cancel = False
End If
Else
MsgBox ("社員番号を入力してください。")
Cancel = True
End If
End If
End Sub

Private Function funcSearchNumber(myNumber As Variant) As Boolean
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T社員", dbOpenDynaset)

rs.FindFirst "社員番号=" & myNumber
If rs.NoMatch Then
funcSearchNumber = False
Else
funcSearchNumber = True
End If
End Function