【Access】顧客管理カルテを修正（複数顧客名対応）

以前マイクロソフトアクセスデータベース（以下Access）作成したデータベースを修正しました。

【Access】顧客管理カルテを作成（VBAで追加、削除など）

同名の場合は、携帯電話番号がユニークになるから「携帯番号で検索してください」と言う感じにしました。

しかし、携帯番号を調べる手間を省きたいという要望です。つまり、

となります。

氏名が複数該当する時の選択フォーム準備

まず、氏名検索のテキストボックスを検索キーとして、「顧客マスタ」からクエリーを作成しました。

これで、曖昧な氏名から顧客マスタを抽出することができます。

次に、フォームを作成して、「顧客重複確認」というネーミングを付けました。

顧客管理カルテの氏名から、「検索」ボタンをクリックすることで、同名が複数いる場合は、

「複数の顧客データが存在します。電話番号で検索してください。」と言うメッセージを出していましたが、それをコメントアウトして、「顧客重複確認」のフォームを起動する事にしました。

Private Sub 検索_Click()
'変数を定義
Dim cnn As ADODB.Connection
Dim rs1 As ADODB.Recordset

'変数にADOオブジェクトを代入
Set cnn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient

'レコードセットを取得
rs1.Open "顧客マスタ", cnn, adOpenKeyset, adLockOptimistic

    If IsNull(s_name) Then
            rs1.Filter = "電話番号 Like '*" & Me!s_tel & "*'"
        Else
            rs1.Filter = "氏名 Like '*" & Me!s_name & "*'"
    End If

'対象レコードが無い場合
If rs1.RecordCount = 0 Then
    MsgBox ("条件に一致するデータは存在しませんでした。")
    s_name = Null
    '処理終了
    Exit Sub

ElseIf rs1.RecordCount = 1 Then
    s_ID = rs1!ID
    s_name = rs1!氏名
    s_tel = rs1!電話番号

'対象レコードがある場合
Else

DoCmd.OpenForm "顧客重複チェック", acNormal, , , acFormEdit, acWindowNormal

'    MsgBox ("複数の顧客データが存在します。電話番号で検索してください。")
'        s_ID = rs1!ID
'    s_name = rs1!氏名
'    s_tel = rs1!電話番号


End If

'終了処理
rs1.Close: Set rs1 = Nothing
cnn.Close: Set cnn = Nothing


End Sub

新規追加のフィールドが消えない！？

「顧客重複確認」のフォームが開きますが、一番下に新規のレコード登録画面が出ており、すごい違和感のある状態になっていました。

普通なら、「追加の許可」をいいえにするだけで表示されないはずですが、どうしてもダメです。

顧客を選択した後の動作

顧客を選択した後の動作は、選択した顧客名と電話番号を「顧客管理カルテ」の氏名検索と電話番号検索のテキストボックスに代入させました。

Private Sub Select_Click()

Forms![管理データ]![s_name] = 氏名
Forms![管理データ]![s_tel] = 電話番号
DoCmd.Close acForm, "顧客重複チェック", acSaveNo
    
'DoCmd.ShowAllRecords
'Call Form_管理データ.検索_Click

End Sub

代入した後に、「顧客管理カルテ」の氏名検索と電話番号検索の値から「種目」を選択した時に、管理データが更新されるように

'DoCmd.ShowAllRecords

'Call Form_管理データ.検索_Click

などを設置してみましたが、この場所では無いようなのでコメントアウトしました。

「種目」を選択後に更新されればよいようです。

Private Sub s_Event_AfterUpdate()

If IsNull(s_name) Then
MsgBox ("名前が入力されていません。")
s_Event = Null
Exit Sub
End If

If IsNull(s_tel) Then
MsgBox ("電話番号が入力されていません。")
s_Event = Null
Exit Sub
End If

DoCmd.ShowAllRecords

End Sub

ちょっと内容がいろいろと飛んでいますので理解しずらいかと思いますが、今回の発見は、「スナップショット」という部分かと思います。

これを探すまでに３０分は要しました。