Access データの重複なし

Question

顧客フォームと顧客登録フォームというフォームを作成しました。顧客フォームには登録画面ボタンを作成しボタンクリック時に顧客登録フォームに移動するようになっています。

顧客登録フォームには、顧客番号、顧客名を入力します。

顧客登録フォームで入力したデータは顧客フォームに新規レコードとして追加されるようにしました。

そこで質問なのですが、顧客登録フォームで入力した内容が登録済みの　顧客番号、顧客名、２つとも重複している場合に「そのデータはすでに登録済みです」というメッセージを出したいのですがどのようなVBAを組めばいいのかご教示願います。

環境は以下の通りです。

OS:win7
ver:2003

Comments

[sazi]

顧客登録フォームは連結フォームですか？

[misima]

はい！連結フォームです

Answer 1

連結フォームということなので、フォームの「挿入前処理」イベントでチェックすれば、Cancelによって挿入を中止することができます。

Private Sub Form_BeforeInsert(Cancel As Integer)
If DCount("テーブルの主キー", "テーブル名", "顧客番号=" & Me.顧客番号のコントロール名 & " and 顧客名=" & Me.顧客名のコントロール名) > 0 Then
    MsgBox "そのデータはすでに登録済みです"
    Cancel = True
End If
End Sub

Comments

[misima]

回答ありがとうございます!試してみます

[misima]

今回はsaziさんのご回答でVBAを組ませていただきました。ご回答ありがとうございました。

Answer 2

せっかくのAccess(データベース)なので、データを格納するテーブル側で主キーかユニーク制約をかけておいて、INSERTしてみてエラーになったらメッセージ表示ではだめでしょうか。

参考） http://tsware.jp/tips/tips_593.htm

Comments

[misima]

回答ありがとうございます!試してみます

Answer 3

DAOを用いてレコード検索を行う方法 ： VBAのTips解説

顧客データを格納するテーブルをOpenRecordsetメソッドで開いて、
FindFirstメソッドで顧客番号、顧客名を条件に合致するレコードを検索。
NoMatchで既存データがないことを確認してからデータ追加のためにAddNewする流れです。

Comments

[misima]

回答ありがとうございます!試してみます

[退会済みユーザー]

よく考えたら、フォームのデータソースで既に顧客マスターテーブルと連結しちゃっているんですね、
私の書いた方法は非連結が前提のものだったので、saziさん案が良いかもです。

[misima]

なるほど。
ですが
m6u様のご回答も今後に生かせるとおもうので、ご回答に感謝です。

Answer 4

標準モジュールに

'処理モード(コード)
Public Const COM_SHORI_CODE_INSERT            As Integer = 0
Public Const COM_SHORI_CODE_UPDATE            As Integer = 1
'処理モード(文言)
Public Const COM_SHORI_MONGON_INSERT          As String = "新規登録"
Public Const COM_SHORI_MONGON_UPDATE          As String = "更新登録"

'//////////////////////////////////////////////////////////
'
' 件数取得
'
'//////////////////////////////////////////////////////////
Public Function GetRowCnt(ByVal tblName As String, _
                            Optional strWhere As String) As Long
                            
On Error GoTo Err_Proc

    Dim strSQL      As String
    Dim rs          As Recordset
    Dim cnt         As Long
    
    '初期化
    cnt = 0
    
    'SQL文字列生成
    strSQL = "SELECT COUNT(*) AS rowcnt FROM " & tblName & " "
    '抽出条件生成
    If IsNull(strWhere) = False Then
        strSQL = strSQL & strWhere
    End If
        
    'データ取得
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    '最大値取得
    If Not rs Is Nothing Then
        If (IsNull(rs![RowCnt]) = False) Then
            cnt = rs![RowCnt]
        Else
            cnt = 0
        End If
    Else
        cnt = 0
    End If
           
   '戻りセット
   GetRowCnt = cnt
   
Exit_Proc:

   'オブジェクト破棄
   If Not rs Is Nothing Then
    Set rs = Nothing
   End If
   
    Exit Function

Err_Proc:

    Resume Exit_Proc
    
End Function

顧客登録フォームに

'//////////////////////////////////////////////////////////
'
' プライベート変数
'
'//////////////////////////////////////////////////////////
Dim m_shori_mode                       As String                   '処理モード
Dim m_顧客番号                      As String                   '顧客番号

'//////////////////////////////////////////////////////////
'
' チェック処理
'
'//////////////////////////////////////////////////////////
Private Function CheckInput() As Boolean

On Error GoTo Err_Proc

    '=================================================
    ' 重複登録チェック
    '=================================================
    Dim strWhere                As String

    If (m_shori_mode = COM_SHORI_CODE_INSERT) Then
        ' 抽出条件生成
        strWhere = "  WHERE 顧客テーブル.顧客番号 = '" & Me.顧客番号 & "'"

        ' 件数チェック
        If (GetRowCnt("顧客テーブル", strWhere) > 0) Then
            MsgBox "入力された「顧客番号」は既に登録されています。", vbExclamation, "コード重複エラー"
            Me.顧客番号.SetFocus
            CheckInput = False
            GoTo Exit_Proc
        End If

    ' 戻り値設定
    CheckInput = True

Exit_Proc:
    Exit Function

Err_Proc:

Err.Number)
    MsgBox (Err.Number & ", " & Err.Description)
    '戻りセット
    CheckInput = False
    Resume Exit_Proc

End Function

'//////////////////////////////////////////////////////////
'
' 登録ボタン：クリック時処理
'
'//////////////////////////////////////////////////////////
Private Sub cmd_sign_Click()
On Error GoTo Err_Proc

    ' 確認MSG
    If (vbYes = MsgBox("登録処理を実行します。" & vbCrLf & "宜しいですか？", vbYesNo, "登録確認")) Then
        '入力項目チェック
        If (CheckInput = True) Then
'登録処理
'            '処理指定
'            Select Case m_shori_mode
'                Case COM_SHORI_CODE_INSERT
'                    ' 新規登録処理
'                    If (InsertData = False) Then
'                        MsgBox "新規登録処理でエラーが発生しました。", vbCritical, "エラー発生"
'                        Exit Sub
'                    Else
'                        MsgBox "登録処理が完了しました。", vbInformation, "処理完了"
'                        '画面を閉じる
'                        DoCmd.Close
'                    End If
'                Case COM_SHORI_CODE_UPDATE
'                    ' 更新登録処理
'                    If (UpdateData(m_顧客番号) = False) Then
'                        MsgBox "更新登録処理でエラーが発生しました。", vbCritical, "エラー発生"
'                        Exit Sub
'                    Else
'                        MsgBox "登録処理が完了しました。", vbInformation, "処理完了"
'                        '画面を閉じる
'                        DoCmd.Close
'                    End If
'            End Select
        End If
    End If

Exit_Proc:
    Exit Sub

Err_Proc:
    MsgBox (Err.Number & ", " & Err.Description)
    Resume Exit_Proc
End Sub

というような感じで私はやってます。

Comments

[misima]

回答ありがとうございます！試してみます